home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cnstrnts / thinglab.lha / ThingLabII / Things.v2.st < prev   
Text File  |  1993-07-24  |  100KB  |  4,432 lines
  1. "ThingLabII Primitive Things of (20 May 1990 3:38:23 pm )"!
  2.  
  3. "Copyright (c) 1989 and 1990, Regents of the University of Washington.
  4. Permission is granted to use or reproduce this program for research
  5. and development purposes only. For information regarding the use of this
  6. program in a commercial product, contact:
  7.  
  8.     Office of Technology Transfer
  9.     University of Washington
  10.     4225 Roosevelt Way NE, Suite 301
  11.     Seattle, WA  98105
  12.  
  13. ThingLab II was written between 1988 and 1990 by John Maloney and
  14. Bjorn N. Freeman-Benson with the guidance of Alan Borning."!
  15. PrimitiveThing subclass: #PointThing
  16.     instanceVariableNames: 'x y '
  17.     classVariableNames: 'DisplayForm '
  18.     poolDictionaries: ''
  19.     category: 'Things-Primitive'!
  20.  
  21.  
  22. !PointThing methodsFor: 'initialization'!
  23.  
  24. initializeValues
  25.  
  26.     self set: #x to: 20.
  27.     self set: #y to: 20.! !
  28.  
  29. !PointThing methodsFor: 'access'!
  30.  
  31. asPoint
  32.  
  33.     ^x@y!
  34.  
  35. primx: aValue
  36.  
  37.     x _ aValue.!
  38.  
  39. primy: aValue
  40.  
  41.     y _ aValue.!
  42.  
  43. x
  44.  
  45.     ^x!
  46.  
  47. y
  48.  
  49.     ^y! !
  50.  
  51. !PointThing methodsFor: 'glyphs'!
  52.  
  53. boundingBox
  54.     "Answer a box around my DisplayForm centered on my location."
  55.  
  56.     ^((x@y) + DisplayForm offset)
  57.         extent: (DisplayForm extent)!
  58.  
  59. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  60.     "Display my display form at my location."
  61.  
  62.     DisplayForm
  63.         displayOn: aDisplayMedium
  64.         at: (aDisplayPoint + (x@y))
  65.         clippingBox: clipBox
  66.         rule: (Form paint)
  67.         mask: (Form black)!
  68.  
  69. glyphDependsOn
  70.  
  71.     ^Array with: self!
  72.  
  73. location
  74.     "That's me!!"
  75.  
  76.     ^self!
  77.  
  78. selectableGlyphsInto: aSet
  79.  
  80.     aSet add: self.!
  81.  
  82. visibleGlyphsInto: aSet
  83.  
  84.     aSet add: self.! !
  85. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  86.  
  87. PointThing class
  88.     instanceVariableNames: ''!
  89.  
  90.  
  91. !PointThing class methodsFor: 'class initialization'!
  92.  
  93. initialize
  94.     "PointThing initialize"
  95.  
  96.     self initializePrimitive.
  97.     partIcon _ Form
  98.         extent: 16@16
  99.         fromArray: #(0 0 0 0 0 896 1984 1984 1984 896 0 0 0 0 0 0 )
  100.         offset: 0@0.
  101.     explainText _ 'A Point is the fundamental unit of location and movement within ThingLabII'.
  102.     DisplayForm _ (Form dotOfSize: 4) offset: -2@-2.! !
  103.  
  104. PointThing initialize!
  105.  
  106. PrimitiveThing subclass: #SimpleRectThing
  107.     instanceVariableNames: 'topLeft center bottomRight extent fillMask fillRule '
  108.     classVariableNames: ''
  109.     poolDictionaries: ''
  110.     category: 'Things-Private'!
  111.  
  112.  
  113. !SimpleRectThing methodsFor: 'initialization'!
  114.  
  115. initializeStructure
  116.  
  117.     topLeft _ PointThing cloneFor: self.
  118.     center _ PointThing cloneFor: self.
  119.     bottomRight _ PointThing cloneFor: self.
  120.     extent _ PointThing cloneFor: self.!
  121.  
  122. initializeValues
  123.  
  124.     self set: #topLeft.x to: 10.
  125.     self set: #topLeft.y to: 10.
  126.     self set: #extent.x to: 40.
  127.     self set: #extent.y to: 30.
  128.     self set: #bottomRight.x to: 50.
  129.     self set: #bottomRight.y to: 40.
  130.     self set: #fillMask to: nil.    "if fillMask is nil, the rectangle is not filled"
  131.     self set: #fillRule to: Form over.! !
  132.  
  133. !SimpleRectThing methodsFor: 'access'!
  134.  
  135. asRectangle
  136.  
  137.     ^topLeft asPoint rounded corner: bottomRight asPoint rounded!
  138.  
  139. bottomRight
  140.  
  141.     ^bottomRight!
  142.  
  143. center
  144.  
  145.     ^center!
  146.  
  147. extent
  148.  
  149.     ^extent!
  150.  
  151. fillMask
  152.  
  153.     ^fillMask!
  154.  
  155. fillRule
  156.  
  157.     ^fillRule!
  158.  
  159. primfillMask: aForm
  160.  
  161.     fillMask _ aForm.!
  162.  
  163. primfillRule: aRule
  164.  
  165.     fillRule _ aRule.!
  166.  
  167. topLeft
  168.  
  169.     ^topLeft! !
  170.  
  171. !SimpleRectThing methodsFor: 'glyphs'!
  172.  
  173. boundingBox
  174.     "Answer my outline rectangle."
  175.  
  176.     ^self asRectangle!
  177.  
  178. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  179.     "If fillMask is not nil, the rectangle is filled according to fillRule and fillMask."
  180.  
  181.     aDisplayMedium border: self boundingBox width: 1.
  182.     (fillMask notNil) ifTrue:
  183.         [aDisplayMedium
  184.             fill: (self boundingBox insetOriginBy: 1@1 cornerBy: 1@1)
  185.             rule: fillRule mask: fillMask].!
  186.  
  187. glyphDependsOn
  188.  
  189.     ^Array
  190.         with: self
  191.         with: topLeft
  192.         with: bottomRight!
  193.  
  194. selectableGlyphsInto: aSet
  195.  
  196.     aSet add: topLeft; add: center; add: bottomRight.!
  197.  
  198. visibleGlyphsInto: aSet
  199.  
  200.     aSet add: self.! !
  201. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  202.  
  203. SimpleRectThing class
  204.     instanceVariableNames: ''!
  205.  
  206.  
  207. !SimpleRectThing class methodsFor: 'class initialization'!
  208.  
  209. initialize
  210.     "SimpleRectThing initialize"
  211.  
  212.     self initializePrimitive.
  213.     partIcon _ (Form
  214.         extent: 16@16
  215.         fromArray: #(0 0 0 0 16380 8196 8196 8196 8196 8196 8196 8196 8196 16380 0 0)
  216.         offset: 0@0).
  217.     explainText _ 'A SimpleRectThing consists of four points (topLeft, center, bottomRight, and extent) and a mask and rule for filling itself with some pattern. If the mask is nil, only its outline is displayed. A SimpleRectThing has no constraints among its parts.'.! !
  218.  
  219. SimpleRectThing initialize!
  220.  
  221. PrimitiveThing subclass: #TrebleClefThing
  222.     instanceVariableNames: 'location middleCOffset width '
  223.     classVariableNames: ''
  224.     poolDictionaries: ''
  225.     category: 'Things-Primitive'!
  226.  
  227.  
  228. !TrebleClefThing methodsFor: 'initialization'!
  229.  
  230. initializeStructure
  231.  
  232.     location _ PointThing cloneFor: self.!
  233.  
  234. initializeValues
  235.  
  236.     self set: #location.x to: 20.
  237.     self set: #location.y to: 40.
  238.     self set: #middleCOffset to: 26.
  239.     self set: #width to: 200.! !
  240.  
  241. !TrebleClefThing methodsFor: 'access'!
  242.  
  243. location
  244.  
  245.     ^location!
  246.  
  247. middleCOffset
  248.  
  249.     ^middleCOffset!
  250.  
  251. primmiddleCOffset: aNumber
  252.  
  253.     middleCOffset _ aNumber.!
  254.  
  255. primwidth: aNumber
  256.  
  257.     width _ aNumber.!
  258.  
  259. width
  260.  
  261.     ^width! !
  262.  
  263. !TrebleClefThing methodsFor: 'glyphs'!
  264.  
  265. boundingBox
  266.  
  267.     ^(self form computeBoundingBox)
  268.         translateBy: self form offset + location asPoint!
  269.  
  270. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  271.  
  272.     | offset rect |
  273.     "display clef"
  274.     self form
  275.         displayOn: aDisplayMedium
  276.         at: aDisplayPoint + location asPoint    
  277.         clippingBox: clipBox.
  278.  
  279.     "display staff"
  280.     0 to: 4 do:
  281.         [: line |
  282.          offset _ line * 5.
  283.          rect _ (location asPoint + (0@offset)) extent: width@1.
  284.          rect _ rect intersect: clipBox.
  285.          aDisplayMedium black: rect].
  286.     rect _ (location asPoint extent: 1@21) intersect: clipBox.
  287.     aDisplayMedium black: rect.
  288.     rect _ (location asPoint + (width@0) extent: 2@21) intersect: clipBox.
  289.     aDisplayMedium black: rect.!
  290.  
  291. form
  292.  
  293.     ^Form
  294.         extent: 13@38
  295.         fromArray: #(384 960 832 832 576 576 704 704 896 896 896 1792 3840 7680 15872 14848 29184 29184 59360 59376 53240 51768 51736 52760 50712 25112 12848 6752 4032 512 512 512 12800 31232 31232 29184 25600 14336)
  296.         offset: 7@-9!
  297.  
  298. glyphDependsOn
  299.  
  300.     ^Array
  301.         with: location
  302.         with: self!
  303.  
  304. selectableGlyphsInto: aSet
  305.  
  306.     aSet add: self.!
  307.  
  308. visibleGlyphsInto: aSet
  309.  
  310.     aSet add: self.! !
  311. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  312.  
  313. TrebleClefThing class
  314.     instanceVariableNames: ''!
  315.  
  316.  
  317. !TrebleClefThing class methodsFor: 'class initialization'!
  318.  
  319. initialize
  320.     "TrebleClefThing initialize"
  321.  
  322.     self initializePrimitive.
  323.     partIcon _ (Form
  324.         extent: 16@16
  325.         fromArray: #(128 192 160 192 384 640 1216 2464 2704 2768 2448 1184 960 128 640 256)
  326.         offset: 0@0).
  327.     explainText _ 'A TrebleClefThing is a staff with built in treble clef. The staff width is determined by the width component while the vertical offset of middle C (from the top of the staff) is given by the middleCOffset component.'.! !
  328.  
  329. TrebleClefThing initialize!
  330.  
  331. SimpleRectThing subclass: #RectThing
  332.     instanceVariableNames: ''
  333.     classVariableNames: ''
  334.     poolDictionaries: ''
  335.     category: 'Things-Primitive'!
  336.  
  337.  
  338. !RectThing methodsFor: 'initialization'!
  339.  
  340. initializeConstraints
  341.     "RectThing initialize"
  342.  
  343.     | c |
  344.     self weakDefaultStay: #extent.x.
  345.     self weakDefaultStay: #extent.y.
  346.     c _ Constraint
  347.         symbols: #(p1 center p2 delta)
  348.         methodStrings: #(
  349.             'p1 _ (center - (delta / 2.0)) rounded.
  350.                p2 _ (center + (delta / 2.0)) rounded'
  351.             'p1 _ p2 - delta.
  352.                center _ (p2 - (delta / 2.0)) rounded'
  353.             'p1 _ p2 - ((p2 - center) * 2).
  354.                delta _ ((p2 - center) * 2)'
  355.             'center _ (p1 + (delta / 2.0)) rounded.
  356.                 p2 _ p1 + delta'
  357.             'center _ ((p1 + p2) / 2.0) rounded.
  358.                delta _ (p2 - p1)'
  359.             'p2 _ p1 + ((center - p1) * 2).
  360.                delta _ ((center - p1) * 2)').
  361.     self addConstraint:
  362.         (c clone bind: (Array
  363.             with: self->#topLeft.x
  364.             with: self->#center.x
  365.             with: self->#bottomRight.x
  366.             with: self->#extent.x) strength: #required).
  367.     self addConstraint:
  368.         (c clone bind: (Array
  369.             with: self->#topLeft.y
  370.             with: self->#center.y
  371.             with: self->#bottomRight.y
  372.             with: self->#extent.y) strength: #required).! !
  373. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  374.  
  375. RectThing class
  376.     instanceVariableNames: ''!
  377.  
  378.  
  379. !RectThing class methodsFor: 'class initialization'!
  380.  
  381. initialize
  382.     "RectThing initialize"
  383.  
  384.     self initializePrimitive.
  385.     partIcon _ (Form
  386.         extent: 16@16
  387.         fromArray: #(0 0 0 0 16380 8196 8196 8196 8196 8196 8196 8196 8196 16380 0 0)
  388.         offset: 0@0).
  389.     explainText _ 'A RectThing is like a SimpleRectThing but the corners, center, and extent are constrained so that that given any two of these we can compute the others. This generality is expensive, however, so it it best to use one of the more limited varieties of rectangle things (CenterRectThing or FixedRectThing) where appropriate.'.! !
  390.  
  391. RectThing initialize!
  392.  
  393. PrimitiveThing subclass: #PointAnchor
  394.     instanceVariableNames: 'point '
  395.     classVariableNames: 'DisplayForm '
  396.     poolDictionaries: ''
  397.     category: 'Things-Primitive'!
  398.  
  399.  
  400. !PointAnchor methodsFor: 'initialization'!
  401.  
  402. initializeConstraints
  403.     "PointerAnchor initialize"
  404.  
  405.     self stronglyPreferStay: #point.x.
  406.     self stronglyPreferStay: #point.y.!
  407.  
  408. initializeStructure
  409.  
  410.     point _ PointThing cloneFor: self.! !
  411.  
  412. !PointAnchor methodsFor: 'access'!
  413.  
  414. point
  415.  
  416.     ^point! !
  417.  
  418. !PointAnchor methodsFor: 'glyphs'!
  419.  
  420. boundingBox
  421.     "Answer a box around my DisplayForm centered on my location."
  422.  
  423.     ^(self point asPoint + DisplayForm offset)
  424.         extent: (DisplayForm extent)!
  425.  
  426. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  427.     "Display my display form at my location."
  428.  
  429.     DisplayForm
  430.         displayOn: aDisplayMedium
  431.         at: (aDisplayPoint + point asPoint)
  432.         clippingBox: clipBox
  433.         rule: (Form paint)
  434.         mask: (Form black).!
  435.  
  436. glyphDependsOn
  437.  
  438.     ^Array with: point!
  439.  
  440. selectableGlyphsInto: aSet
  441.  
  442.     aSet add: point.!
  443.  
  444. visibleGlyphsInto: aSet
  445.  
  446.     aSet add: point; add: self.! !
  447. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  448.  
  449. PointAnchor class
  450.     instanceVariableNames: ''!
  451.  
  452.  
  453. !PointAnchor class methodsFor: 'class initialization'!
  454.  
  455. initialize
  456.     "PointAnchor initialize"
  457.  
  458.     self initializePrimitive.
  459.     partIcon _ (Form
  460.         extent: 16@16
  461.         fromArray: #(384 960 960 384 384 384 384 8580 29070 63903 8580 12684 6552 4080 2016 0)
  462.         offset: 0@0).
  463.     explainText _ 'A PointAnchor is a point with an attached "preferred stay" constraint.'.
  464.     DisplayForm _ (Form
  465.         extent: 16@15
  466.         fromArray: #(384 960 960 384 384 384 384 8580 29070 63903 8580 12684 6552 4080 2016)
  467.         offset: -8@-2).! !
  468.  
  469. PointAnchor initialize!
  470.  
  471. SimpleRectThing subclass: #CenterRectThing
  472.     instanceVariableNames: ''
  473.     classVariableNames: ''
  474.     poolDictionaries: ''
  475.     category: 'Things-Primitive'!
  476.  
  477.  
  478. !CenterRectThing methodsFor: 'initialization'!
  479.  
  480. initializeConstraints
  481.     "CenterRectThing initialize"
  482.  
  483.     self defaultStay: #topLeft.x.
  484.     self defaultStay: #topLeft.y.
  485.     self prefer: '(p1 + p2) // 2 = center'
  486.         where: #((p1 topLeft.x) (center center.x) (p2 bottomRight.x)).
  487.     self prefer: '(p1 + p2) // 2 = center'
  488.         where: #((p1 topLeft.y) (center center.y) (p2 bottomRight.y)).
  489.     self methods: #('width _ (p2 - p1) abs')
  490.         where: #((width extent.x) (p1 topLeft.x) (p2 bottomRight.x))
  491.         strength: #preferred.
  492.     self methods: #('height _ (p2 - p1) abs')
  493.         where: #((height extent.y) (p1 topLeft.y) (p2 bottomRight.y))
  494.         strength: #preferred.!
  495.  
  496. initializeValues
  497.  
  498.     super initializeValues.
  499.     self set: #bottomRight.x to: 60.
  500.     self set: #bottomRight.y to: 45.! !
  501. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  502.  
  503. CenterRectThing class
  504.     instanceVariableNames: ''!
  505.  
  506.  
  507. !CenterRectThing class methodsFor: 'class initialization'!
  508.  
  509. initialize
  510.     "CenterRectThing initialize"
  511.  
  512.     self initializePrimitive.
  513.     partIcon _ (Form
  514.         extent: 16@16
  515.         fromArray: #(0 0 0 0 16380 8196 8196 8196 8196 8196 8196 8196 8196 16380 0 0)
  516.         offset: 0@0).
  517.     explainText _ 'A CenterRectThing is a SimpleRectThing with the addition of constraints to keep the center point midway between the origin and corner points and to keep the extent point updated. The extent cannot be changed by any other constraints.'.! !
  518.  
  519. CenterRectThing initialize!
  520.  
  521. CenterRectThing subclass: #FrameThing
  522.     instanceVariableNames: ''
  523.     classVariableNames: ''
  524.     poolDictionaries: ''
  525.     category: 'Things-Primitive'!
  526.  
  527.  
  528. !FrameThing methodsFor: 'initialization'!
  529.  
  530. initializeConstraints
  531.     "FrameThing initialize"
  532.  
  533.     self stronglyPreferStay: #topLeft.x.
  534.     self stronglyPreferStay: #topLeft.y.
  535.     self stronglyPreferStay: #bottomRight.x.
  536.     self stronglyPreferStay: #bottomRight.y.!
  537.  
  538. initializeValues
  539.  
  540.     self set: #topLeft.x to: 15.
  541.     self set: #topLeft.y to: 20.
  542.     self set: #bottomRight.x to: 300.
  543.     self set: #bottomRight.y to: 200.! !
  544.  
  545. !FrameThing methodsFor: 'glyphs'!
  546.  
  547. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  548.  
  549.     | myBox w |
  550.     myBox _ self boundingBox.
  551.     myBox _ myBox insetOriginBy: -2@-1 cornerBy: -2@-1.
  552.     w _ 1.
  553.     aDisplayMedium
  554.         fill: ((myBox left - w)@(myBox top - w) extent:
  555.              (w@(myBox height + (2 * w))))
  556.         rule: (Form over)
  557.         mask: (Form black).
  558.     aDisplayMedium
  559.         fill: ((myBox right)@(myBox top - w) extent:
  560.              (w@(myBox height + (2 * w))))
  561.         rule: (Form over)
  562.         mask: (Form black).
  563.  
  564.     aDisplayMedium
  565.         border:  ((myBox left - w)@(myBox top - 8) extent:
  566.              ((myBox width + (2 * w))@8))
  567.         width: 1.
  568.     aDisplayMedium
  569.         fill: ((myBox left - w + 1)@(myBox top - 7) extent:
  570.              ((myBox width - 2 + (2 * w))@6))
  571.         rule: (Form over)
  572.         mask: (Form lightGray).
  573.  
  574.     aDisplayMedium
  575.         fill: ((myBox left - w)@(myBox top - w) extent:
  576.              ((myBox width + (2 * w))@w))
  577.         rule: (Form over)
  578.         mask: (Form black).
  579.     aDisplayMedium
  580.         fill: ((myBox left - w)@(myBox bottom) extent:
  581.              ((myBox width + (2 * w))@w))
  582.         rule: (Form over)
  583.         mask: (Form black).!
  584.  
  585. selectableGlyphsInto: aSet
  586.  
  587.     aSet add: topLeft.
  588.     aSet add: bottomRight.! !
  589. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  590.  
  591. FrameThing class
  592.     instanceVariableNames: ''!
  593.  
  594.  
  595. !FrameThing class methodsFor: 'class initialization'!
  596.  
  597. initialize
  598.     "FrameThing initialize"
  599.  
  600.     self initializePrimitive.
  601.     partIcon _ (Form
  602.         extent: 16@16
  603.         fromArray: #(65535 54613 43691 54613 65535 32769 32769 32769 32769 32769 32769 32769 32769 32769 32769 65535)
  604.         offset: 0@0).
  605.     explainText _ 'A FrameThing acts a the placeholder for the window boundary when constructing stand-alone Things. Both corners are anchored.'.! !
  606.  
  607. FrameThing initialize!
  608.  
  609. PrimitiveThing subclass: #MidPoint
  610.     instanceVariableNames: 'p1 midpoint p2 '
  611.     classVariableNames: 'PenForm '
  612.     poolDictionaries: ''
  613.     category: 'Things-Primitive'!
  614.  
  615.  
  616. !MidPoint methodsFor: 'initialization'!
  617.  
  618. initializeConstraints
  619.     "MidPoint initialize"
  620.  
  621.     self stronglyPrefer: '(p1 + p2) // 2 = midpoint'
  622.         where: #((p1 p1.y) (midpoint midpoint.y) (p2 p2.y)).
  623.     self stronglyPrefer: '(p1 + p2) // 2 = midpoint'
  624.         where: #((p1 p1.x) (midpoint midpoint.x) (p2 p2.x)).
  625.     self defaultStay: #p1.x.
  626.     self defaultStay: #p1.y.
  627.     self defaultStay: #p2.x.
  628.     self defaultStay: #p2.y.!
  629.  
  630. initializeStructure
  631.  
  632.     p1 _ PointThing cloneFor: self.
  633.     midpoint _ PointThing cloneFor: self.
  634.     p2 _ PointThing cloneFor: self.!
  635.  
  636. initializeValues
  637.  
  638.     self set: #p1.x to: 30.
  639.     self set: #p1.y to: 30.
  640.     self set: #p2.x to: 70.
  641.     self set: #p2.y to: 70.! !
  642.  
  643. !MidPoint methodsFor: 'access'!
  644.  
  645. midpoint
  646.  
  647.     ^midpoint!
  648.  
  649. p1
  650.  
  651.     ^p1!
  652.  
  653. p2
  654.  
  655.     ^p2! !
  656. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  657.  
  658. MidPoint class
  659.     instanceVariableNames: ''!
  660.  
  661.  
  662. !MidPoint class methodsFor: 'class initialization'!
  663.  
  664. initialize
  665.     "MidPoint initialize"
  666.  
  667.     self initializePrimitive.
  668.     partIcon _ Form
  669.         extent: 16@16
  670.         fromArray: #(0 0 28 28 28 0 0 896 896 896 0 0 28672 28672 28672 0)
  671.         offset: 0@0.
  672.     explainText _ 'A MidPoint consists of three colinear points with the middle point constrained to lie midway between the other two.'.! !
  673.  
  674. MidPoint initialize!
  675.  
  676. SimpleRectThing subclass: #FixedRectThing
  677.     instanceVariableNames: ''
  678.     classVariableNames: ''
  679.     poolDictionaries: ''
  680.     category: 'Things-Primitive'!
  681.  
  682.  
  683. !FixedRectThing methodsFor: 'initialization'!
  684.  
  685. initializeConstraints
  686.     "FixedRectThing initialize"
  687.  
  688.     self methods: #(
  689.             'p1 _ p2 - width'
  690.             'p2 _ p1 + width')
  691.         where: #((p1 topLeft.x) (p2 bottomRight.x) (width extent.x))
  692.         strength: #preferred.
  693.     self methods: #(
  694.             'p1 _ p2 - height'
  695.             'p2 _ p1 + height')
  696.         where: #((p1 topLeft.y) (p2 bottomRight.y) (height extent.y))
  697.         strength: #preferred.
  698.     self methods: #(
  699.             'center _ p1 + (width // 2)'
  700.             'p1 _ center - (width // 2)')
  701.         where: #((center center.x) (p1 topLeft.x) (width extent.x))
  702.         strength: #preferred.
  703.     self methods: #(
  704.             'center _ p1 + (height // 2)'
  705.             'p1 _ center - (height // 2)')
  706.         where: #((center center.y) (p1 topLeft.y) (height extent.y))
  707.         strength: #preferred.!
  708.  
  709. initializeValues
  710.  
  711.     super initializeValues.
  712.     self set: #extent.x to: 30.
  713.     self set: #extent.y to: 20.! !
  714. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  715.  
  716. FixedRectThing class
  717.     instanceVariableNames: ''!
  718.  
  719.  
  720. !FixedRectThing class methodsFor: 'class initialization'!
  721.  
  722. initialize
  723.     "FixedRectThing initialize"
  724.  
  725.     self initializePrimitive.
  726.     partIcon _ (Form
  727.         extent: 16@16
  728.         fromArray: #(0 0 0 0 16380 8196 8196 8196 8196 8196 8196 8196 8196 16380 0 0)
  729.         offset: 0@0).
  730.     explainText _ 'A FixedRectThing is a SimpleRectThing with the addition of constraints that use its width and height to compute a corner and the center given the other corner. The center cannot be changed by any other constraints but the extent can.'.! !
  731.  
  732. FixedRectThing initialize!
  733.  
  734. PrimitiveThing subclass: #LineThing
  735.     instanceVariableNames: 'p1 p2 '
  736.     classVariableNames: 'PenForm '
  737.     poolDictionaries: ''
  738.     category: 'Things-Primitive'!
  739.  
  740.  
  741. !LineThing methodsFor: 'initialization'!
  742.  
  743. initializeStructure
  744.  
  745.     p1 _ PointThing cloneFor: self.
  746.     p2 _ PointThing cloneFor: self.!
  747.  
  748. initializeValues
  749.  
  750.     self set: #p1.x to: 10.
  751.     self set: #p1.y to: 10.    
  752.     self set: #p2.x to: 30.
  753.     self set: #p2.y to: 30.! !
  754.  
  755. !LineThing methodsFor: 'access'!
  756.  
  757. p1
  758.  
  759.     ^p1!
  760.  
  761. p2
  762.  
  763.     ^p2! !
  764.  
  765. !LineThing methodsFor: 'glyphs'!
  766.  
  767. boundingBox
  768.     "Return the smallest rectangle enclosing both my endpoints."
  769.  
  770.     | point1 point2 |
  771.     point1 _ p1 asPoint.
  772.     point2 _ p2 asPoint.
  773.     ^(point1 min: point2) corner: (point1 max: point2)!
  774.  
  775. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  776.     "Display the line segment between my endpoints."
  777.  
  778.     (Line
  779.         from: (p1 asPoint)
  780.         to: (p2 asPoint)
  781.         withForm: PenForm)
  782.             displayOn: aDisplayMedium
  783.             at: aDisplayPoint
  784.             clippingBox: clipBox
  785.             rule: (Form paint)
  786.             mask: (Form black).!
  787.  
  788. glyphDependsOn
  789.  
  790.     ^Array
  791.         with: p1
  792.         with: p2!
  793.  
  794. selectableGlyphsInto: aSet
  795.  
  796.     aSet add: p1; add: p2.!
  797.  
  798. visibleGlyphsInto: aSet
  799.  
  800.     aSet add: p1; add: p2; add: self.! !
  801. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  802.  
  803. LineThing class
  804.     instanceVariableNames: ''!
  805.  
  806.  
  807. !LineThing class methodsFor: 'class initialization'!
  808.  
  809. initialize
  810.     "LineThing initialize"
  811.  
  812.     self initializePrimitive.
  813.     partIcon _ Form
  814.         extent: 16 @ 16
  815.         fromArray: #(0 2 6 12 24 48 96 192 384 768 1536 3072 6144 12288 8192 0)
  816.         offset: 0 @ 0.
  817.     explainText _ 'A LineThing is an unconstrained line. It consists of two points connected by a line segment.'.
  818.     PenForm _ Form dotOfSize: 1.! !
  819.  
  820. LineThing initialize!
  821.  
  822. LineThing subclass: #PlainLine
  823.     instanceVariableNames: ''
  824.     classVariableNames: ''
  825.     poolDictionaries: ''
  826.     category: 'Things-Primitive'!
  827.  
  828.  
  829. !PlainLine methodsFor: 'glyphs'!
  830.  
  831. visibleGlyphsInto: aSet
  832.  
  833.     aSet add: self.! !
  834. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  835.  
  836. PlainLine class
  837.     instanceVariableNames: ''!
  838.  
  839.  
  840. !PlainLine class methodsFor: 'class initialization'!
  841.  
  842. initialize
  843.     "PlainLine initialize"
  844.  
  845.     self initializePrimitive.
  846.     partIcon _ (Form
  847.         extent: 16@16
  848.         fromArray: #(0 2 6 12 24 48 96 192 384 768 1536 3072 6144 12288 8192 0)
  849.         offset: 0@0).
  850.     explainText _ 'A PlainLine is like a regular line except that the endpoints are not displayed.'.! !
  851.  
  852. PlainLine initialize!
  853.  
  854. LineThing subclass: #VLine
  855.     instanceVariableNames: ''
  856.     classVariableNames: ''
  857.     poolDictionaries: ''
  858.     category: 'Things-Primitive'!
  859.  
  860.  
  861. !VLine methodsFor: 'initialization'!
  862.  
  863. initializeConstraints
  864.     "VLine initialize"
  865.  
  866.     self stronglyPrefer: #p1.x equals: #p2.x.! !
  867. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  868.  
  869. VLine class
  870.     instanceVariableNames: ''!
  871.  
  872.  
  873. !VLine class methodsFor: 'class initialization'!
  874.  
  875. initialize
  876.     "VLine initialize"
  877.  
  878.     self initializePrimitive.
  879.     partIcon _ (Form
  880.         extent: 16@16
  881.         fromArray: #(384 960 960 384 384 384 384 384 384 384 384 384 384 960 960 384)
  882.         offset: 0@0).
  883.     explainText _ 'A VLine is a LineThing constrained to remain vertical.'.! !
  884.  
  885. VLine initialize!
  886.  
  887. LineThing subclass: #HLine
  888.     instanceVariableNames: ''
  889.     classVariableNames: ''
  890.     poolDictionaries: ''
  891.     category: 'Things-Primitive'!
  892.  
  893.  
  894. !HLine methodsFor: 'initialization'!
  895.  
  896. initializeConstraints
  897.     "HLine initialize"
  898.  
  899.     self stronglyPrefer: #p1.y equals: #p2.y.! !
  900. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  901.  
  902. HLine class
  903.     instanceVariableNames: ''!
  904.  
  905.  
  906. !HLine class methodsFor: 'class initialization'!
  907.  
  908. initialize
  909.     "HLine initialize"
  910.  
  911.     self initializePrimitive.
  912.     partIcon _ (Form
  913.         extent: 16@16
  914.         fromArray: #(0 0 0 0 0 0 24582 65535 65535 24582 0 0 0 0 0 0)
  915.         offset: 0@0).
  916.     explainText _ 'An HLine is a line constrained to remain horizontal'.! !
  917.  
  918. HLine initialize!
  919.  
  920. PrimitiveThing subclass: #ListThing
  921.     instanceVariableNames: 'box itemsList selected '
  922.     classVariableNames: ''
  923.     poolDictionaries: ''
  924.     category: 'Things-Primitive'!
  925.  
  926.  
  927. !ListThing methodsFor: 'initialization'!
  928.  
  929. initializeStructure
  930.  
  931.     box _ CenterRectThing cloneFor: self.!
  932.  
  933. initializeValues
  934.  
  935.     self set: #box.bottomRight.x to: 70.
  936.     self set: #box.bottomRight.y to: 70.
  937.     self set: #itemsList to: #(Apple Pear Orange Tangerine).
  938.     self set: #selected to: #Pear.! !
  939.  
  940. !ListThing methodsFor: 'access'!
  941.  
  942. box
  943.  
  944.     ^box!
  945.  
  946. itemsList
  947.  
  948.     ^itemsList!
  949.  
  950. primitemsList: aCollectionOfStringsOrSymbols
  951.  
  952.     itemsList _ aCollectionOfStringsOrSymbols.!
  953.  
  954. primselected: aSymbol
  955.  
  956.     selected _ aSymbol.!
  957.  
  958. selected
  959.  
  960.     ^selected! !
  961.  
  962. !ListThing methodsFor: 'glyphs'!
  963.  
  964. boundingBox
  965.  
  966.     ^box asRectangle!
  967.  
  968. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  969.     "Print my items list in my box and highlight the selected item, if any."
  970.  
  971.     | itemsBox lineHeight left y thisItemBox index highLightBox |
  972.     itemsBox _ (self boundingBox moveBy: aDisplayPoint) insetBy: 2.
  973.     lineHeight _ QuickPrint lineHeight.
  974.     left _ itemsBox left.
  975.     y _ itemsBox top.
  976.     itemsList do:
  977.         [: item |
  978.          thisItemBox _ ((left + 1)@y) corner: itemsBox bottomRight.
  979.          (QuickPrint
  980.             newOn: aDisplayMedium
  981.             box: thisItemBox) drawString: item asString.
  982.          y _ y + lineHeight].
  983.  
  984.     index _ itemsList indexOf: selected ifAbsent: [0].
  985.     ((index > 0) & (index <= itemsList size)) ifTrue:
  986.         [highLightBox _
  987.             (left@(itemsBox top + (lineHeight * (index - 1))))
  988.                 extent: (itemsBox width@lineHeight).
  989.          highLightBox _ highLightBox intersect: itemsBox.
  990.          aDisplayMedium reverse: highLightBox].!
  991.  
  992. glyphDependsOn
  993.  
  994.     ^Array
  995.         with: self
  996.         with: box topLeft
  997.         with: box bottomRight!
  998.  
  999. inputGlyphsInto: aSet
  1000.  
  1001.     aSet add: self.!
  1002.  
  1003. selectableGlyphsInto: aSet
  1004.  
  1005.     aSet
  1006.         add: box topLeft;
  1007.         add: box bottomRight.!
  1008.  
  1009. visibleGlyphsInto: aSet
  1010.  
  1011.     box visibleGlyphsInto: aSet.
  1012.     aSet add: self.! !
  1013.  
  1014. !ListThing methodsFor: 'mouse'!
  1015.  
  1016. handleMouseMove: mousePoint view: aView
  1017.  
  1018.     | myBox index |
  1019.     myBox _ self boundingBox.
  1020.     (myBox containsPoint: mousePoint)
  1021.         ifTrue:
  1022.             [index _
  1023.                 ((mousePoint y - myBox top) // QuickPrint lineHeight) + 1.
  1024.              ((index <= itemsList size) and:
  1025.               [(itemsList at: index) isEmpty not])
  1026.                 ifTrue: [selected _ itemsList at: index]
  1027.                 ifFalse: [selected _ nil]]
  1028.         ifFalse: [selected _ nil].!
  1029.  
  1030. mouseConstraints
  1031.  
  1032.     ^Array with: (
  1033.         EditConstraint
  1034.             ref:     self->#selected
  1035.             strength: ThingLabII editStrength)!
  1036.  
  1037. wantsMouse
  1038.  
  1039.     ^true! !
  1040. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1041.  
  1042. ListThing class
  1043.     instanceVariableNames: ''!
  1044.  
  1045.  
  1046. !ListThing class methodsFor: 'class initialization'!
  1047.  
  1048. initialize
  1049.     "ListThing initialize"
  1050.  
  1051.     self initializePrimitive.
  1052.     partIcon _ (Form
  1053.         extent: 16@16
  1054.         fromArray: #(65532 32774 49142 32774 49142 32774 65534 61502 65534 32774 49142 32774 49142 32774 65534 32766)
  1055.         offset: 0@0).
  1056.     explainText _ 'A ListThing consists of an itemsList, a bounding rectangle, and a selected item field that is nil if no item is selected.'.! !
  1057.  
  1058. ListThing initialize!
  1059.  
  1060. PrimitiveThing subclass: #Node
  1061.     instanceVariableNames: 'location value last '
  1062.     classVariableNames: 'DisplayForm '
  1063.     poolDictionaries: ''
  1064.     category: 'Things-Primitive'!
  1065.  
  1066.  
  1067. !Node methodsFor: 'initialization'!
  1068.  
  1069. initializeStructure
  1070.  
  1071.     location _ PointThing cloneFor: self.!
  1072.  
  1073. initializeValues
  1074.  
  1075.     self set: #location.x to: 20.
  1076.     self set: #location.y to: 20.
  1077.     self set: #value to: nil.
  1078.     self set: #last to: nil.! !
  1079.  
  1080. !Node methodsFor: 'access'!
  1081.  
  1082. last
  1083.  
  1084.     ^last!
  1085.  
  1086. location
  1087.  
  1088.     ^location!
  1089.  
  1090. primlast: aValue
  1091.  
  1092.     last _ aValue.!
  1093.  
  1094. primvalue: aValue
  1095.  
  1096.     value _ aValue.!
  1097.  
  1098. value
  1099.  
  1100.     ^value! !
  1101.  
  1102. !Node methodsFor: 'glyphs'!
  1103.  
  1104. boundingBox
  1105.     "Answer a box around my DisplayForm centered on my location."
  1106.  
  1107.     ^(self location asPoint + DisplayForm offset)
  1108.         extent: (DisplayForm extent)!
  1109.  
  1110. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1111.     "Display my display form at my location."
  1112.  
  1113.     DisplayForm
  1114.         displayOn: aDisplayMedium
  1115.         at: (aDisplayPoint + (location asPoint))
  1116.         clippingBox: clipBox
  1117.         rule: (Form paint)
  1118.         mask: (Form black)!
  1119.  
  1120. glyphDependsOn
  1121.  
  1122.     ^Array with: self location!
  1123.  
  1124. selectableGlyphsInto: aSet
  1125.  
  1126.     aSet add: self.!
  1127.  
  1128. visibleGlyphsInto: aSet
  1129.  
  1130.     aSet add: self.! !
  1131.  
  1132. !Node methodsFor: 'history'!
  1133.  
  1134. advanceHistory
  1135.  
  1136.     last _ value.!
  1137.  
  1138. keepsHistory
  1139.  
  1140.     ^true! !
  1141. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1142.  
  1143. Node class
  1144.     instanceVariableNames: ''!
  1145.  
  1146.  
  1147. !Node class methodsFor: 'class initialization'!
  1148.  
  1149. initialize
  1150.     "Node initialize"
  1151.  
  1152.     self initializePrimitive.
  1153.     partIcon _ (Form
  1154.         extent: 16@16
  1155.         fromArray: #(0 0 0 0 0 2016 2016 2016 2016 2016 2016 0 0 0 0 0)
  1156.         offset: 0@0).
  1157.     explainText _ 'A Node is a value holder. It has a location and a value, which can be of any type. It also maintains a history of the last several values it has held.'.
  1158.     DisplayForm _ (Form extent: 4@4) offset: -2@-2; black.! !
  1159.  
  1160. Node initialize!
  1161.  
  1162. PrimitiveThing subclass: #VScrollThing
  1163.     instanceVariableNames: 'box node minVal maxVal '
  1164.     classVariableNames: ''
  1165.     poolDictionaries: ''
  1166.     category: 'Things-Primitive'!
  1167.  
  1168.  
  1169. !VScrollThing methodsFor: 'initialization'!
  1170.  
  1171. initializeConstraints
  1172.     "VScrollThing initialize"
  1173.  
  1174.     "layout constraints"
  1175.     self offset: #node.location.x by: 0 from: #box.center.x.
  1176.     self offset: #node.location.y by: 6 from: #box.bottomRight.y.!
  1177.  
  1178. initializeStructure
  1179.  
  1180.     box _ FixedRectThing cloneFor: self.
  1181.     node _ Node cloneFor: self.!
  1182.  
  1183. initializeValues
  1184.  
  1185.     self set: #box.extent.x to: 10.
  1186.     self set: #box.extent.y to: 40.
  1187.     self set: #node.location.x to: 25.
  1188.     self set: #node.location.y to: 60.
  1189.     self set: #node.value to: 0.5.
  1190.     self set: #minVal to: 0.0.
  1191.     self set: #maxVal to: 100.0.! !
  1192.  
  1193. !VScrollThing methodsFor: 'access'!
  1194.  
  1195. box
  1196.  
  1197.     ^box!
  1198.  
  1199. maxVal
  1200.  
  1201.     ^maxVal!
  1202.  
  1203. minVal
  1204.  
  1205.     ^minVal!
  1206.  
  1207. node
  1208.  
  1209.     ^node!
  1210.  
  1211. primmaxVal: aNumber
  1212.  
  1213.     maxVal _ aNumber.!
  1214.  
  1215. primminVal: aNumber
  1216.  
  1217.     minVal _ aNumber.! !
  1218.  
  1219. !VScrollThing methodsFor: 'glyphs'!
  1220.  
  1221. boundingBox
  1222.     "Answer my box as a Rectangle."
  1223.  
  1224.     ^box asRectangle!
  1225.  
  1226. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1227.     "Display my marker."
  1228.  
  1229.     aDisplayMedium
  1230.         border:
  1231.             (((box topLeft x@self markerY) extent: (box extent x@1))
  1232.                  moveBy: aDisplayPoint)
  1233.         width: 1.!
  1234.  
  1235. glyphDependsOn
  1236.  
  1237.     ^(Array
  1238.         with: self
  1239.         with: box topLeft
  1240.         with: box bottomRight),
  1241.      (Array with: node)!
  1242.  
  1243. inputGlyphsInto: aSet
  1244.  
  1245.     aSet add: self.!
  1246.  
  1247. markerY
  1248.     "Answer the vertical position of my marker."
  1249.  
  1250.     | myBox y |
  1251.     myBox _ box asRectangle.
  1252.     y _ myBox bottom -
  1253.         ((node value asFloat - minVal) * myBox height / (maxVal - minVal)).
  1254.     ^(y rounded max: myBox top + 1) min: myBox bottom - 2!
  1255.  
  1256. selectableGlyphsInto: aSet
  1257.  
  1258.     aSet add: node.!
  1259.  
  1260. visibleGlyphsInto: aSet
  1261.  
  1262.     aSet add: box; add: node; add: self.! !
  1263.  
  1264. !VScrollThing methodsFor: 'mouse'!
  1265.  
  1266. handleMouseMove: mousePoint view: aView
  1267.     "Set my marker from the mouse. Ensure that the marker is between the top and bottom of my box."
  1268.  
  1269.     | myBox relativeY percent |
  1270.     myBox _ box asRectangle.
  1271.     relativeY _
  1272.         ((myBox bottom - mousePoint y) max: 0) min: myBox height.
  1273.     percent _ relativeY asFloat / myBox height.
  1274.     node primvalue: (minVal + (percent * (maxVal - minVal)))!
  1275.  
  1276. mouseConstraints
  1277.  
  1278.     ^Array with: (
  1279.         EditConstraint
  1280.             ref:     node->#value
  1281.             strength: ThingLabII editStrength)!
  1282.  
  1283. wantsMouse
  1284.  
  1285.     ^true! !
  1286. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1287.  
  1288. VScrollThing class
  1289.     instanceVariableNames: ''!
  1290.  
  1291.  
  1292. !VScrollThing class methodsFor: 'class initialization'!
  1293.  
  1294. initialize
  1295.     "VScrollThing initialize"
  1296.  
  1297.     self initializePrimitive.
  1298.     partIcon _ (Form
  1299.         extent: 16@16
  1300.         fromArray: #(0 2016 1056 1056 1056 2016 1056 1056 1056 1056 1056 1056 1056 1056 1056 2016)
  1301.         offset: 0@0).
  1302.     explainText _ 'A ScrollThing consists a node, a box, and a horizonal marker. The vertical position of the marker within the box is proportional to the value of the node within the range [minVal..maxVal].'.! !
  1303.  
  1304. VScrollThing initialize!
  1305.  
  1306. PrimitiveThing subclass: #NodeAnchor
  1307.     instanceVariableNames: 'node '
  1308.     classVariableNames: 'DisplayForm '
  1309.     poolDictionaries: ''
  1310.     category: 'Things-Primitive'!
  1311.  
  1312.  
  1313. !NodeAnchor methodsFor: 'initialization'!
  1314.  
  1315. initializeConstraints
  1316.     "NodeAnchor initialize"
  1317.  
  1318.     self stronglyPreferStay: #node.value.!
  1319.  
  1320. initializeStructure
  1321.  
  1322.     node _ Node cloneFor: self.! !
  1323.  
  1324. !NodeAnchor methodsFor: 'access'!
  1325.  
  1326. location
  1327.  
  1328.     ^node location!
  1329.  
  1330. node
  1331.  
  1332.     ^node! !
  1333.  
  1334. !NodeAnchor methodsFor: 'glyphs'!
  1335.  
  1336. boundingBox
  1337.     "Answer a box around my DisplayForm centered on my location."
  1338.  
  1339.     ^(self node location asPoint + DisplayForm offset)
  1340.         extent: (DisplayForm extent)!
  1341.  
  1342. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1343.     "Display my display form at my location."
  1344.  
  1345.     DisplayForm
  1346.         displayOn: aDisplayMedium
  1347.         at: (aDisplayPoint + (node location asPoint))
  1348.         clippingBox: clipBox
  1349.         rule: (Form paint)
  1350.         mask: (Form black).!
  1351.  
  1352. glyphDependsOn
  1353.  
  1354.     ^Array with: node location!
  1355.  
  1356. selectableGlyphsInto: aSet
  1357.  
  1358.     aSet add: node.!
  1359.  
  1360. visibleGlyphsInto: aSet
  1361.  
  1362.     aSet add: node; add: self.! !
  1363. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1364.  
  1365. NodeAnchor class
  1366.     instanceVariableNames: ''!
  1367.  
  1368.  
  1369. !NodeAnchor class methodsFor: 'class initialization'!
  1370.  
  1371. initialize
  1372.     "NodeAnchor initialize"
  1373.  
  1374.     self initializePrimitive.
  1375.     partIcon _ (Form
  1376.         extent: 16@16
  1377.         fromArray: #(0 960 960 960 960 384 384 8580 29070 63903 8580 12684 6552 4080 2016 0)
  1378.         offset: 0@0).
  1379.     DisplayForm _ (Form
  1380.         extent: 16@15
  1381.         fromArray: #(960 960 960 960 384 384 384 8580 29070 63903 8580 12684 6552 4080 2016)
  1382.         offset: -8@-2).
  1383.     explainText _ 'A NodeAnchor is a node with an attached "preferred stay" constraint.'.! !
  1384.  
  1385. NodeAnchor initialize!
  1386.  
  1387. PrimitiveThing subclass: #RodThing
  1388.     instanceVariableNames: 'line length p1 p2 p1Force p2Force '
  1389.     classVariableNames: ''
  1390.     poolDictionaries: ''
  1391.     category: 'Things-Private'!
  1392.  
  1393.  
  1394. !RodThing methodsFor: 'initialization'!
  1395.  
  1396. initializeConstraints
  1397.     "RodThing initialize"
  1398.  
  1399.     self stronglyPreferEdit:#p1.last.
  1400.     self stronglyPreferEdit:#p2.last.
  1401.     self stronglyPreferEdit:#p1Force.last.
  1402.     self stronglyPreferEdit:#p2Force.last.
  1403.  
  1404.     "This constraint computes a force vector for each endpoint. The direction of this vector will be parallel to the rod and either inward at each endpoint (if the rod is stretched longer than its nominal length) or outward at each endpoint (if the rod is compressed)."
  1405.  
  1406.     self methods: #(
  1407.             '"a positive magnitude means inward force"
  1408.              forceVector _ (p2 - p1) unitVector * ((p1 - p2) r - length).
  1409.              p1Force _ forceVector.
  1410.              p2Force _ forceVector * -1')
  1411.         where: #((p1 p1.value) (p2 p2.value) (length length.value)
  1412.                  (p1Force p1Force.value) (p2Force p2Force.value))
  1413.         strength: #required.
  1414.  
  1415.     self methods: #(
  1416.             'p _ x@y'
  1417.             'x _ p x.
  1418.              y _ p y')
  1419.         where: #((p p1.value) (x line.p1.x) (y line.p1.y))
  1420.         strength: #required.
  1421.  
  1422.     self methods: #(
  1423.             'p _ x@y'
  1424.             'x _ p x.
  1425.              y _ p y')
  1426.         where: #((p p2.value) (x line.p2.x) (y line.p2.y))
  1427.         strength: #required.!
  1428.  
  1429. initializeStructure
  1430.  
  1431.     line _ LineThing cloneFor: self.
  1432.     length _ Node cloneFor: self.
  1433.     p1 _ Node cloneFor: self.
  1434.     p2 _ Node cloneFor: self.
  1435.     p1Force _ Node cloneFor: self.
  1436.     p2Force _ Node cloneFor: self.!
  1437.  
  1438. initializeValues
  1439.  
  1440.     self set: #length.value to: 30.        "nominal length"
  1441.     self set: #line.p1.x to: 10.
  1442.     self set: #line.p1.y to: 10.    
  1443.     self set: #line.p2.x to: 40.
  1444.     self set: #line.p2.y to: 10.
  1445.     self set: #p1.value to: 10@10.
  1446.     self set: #p1.last to: 10@10.
  1447.     self set: #p2.value to: 40@10.
  1448.     self set: #p2.last to: 40@10.
  1449.     self set: #p1Force.value to: 0.
  1450.     self set: #p1Force.last to: 0.
  1451.     self set: #p2Force.value to: 0.
  1452.     self set: #p2Force.last to: 0.! !
  1453.  
  1454. !RodThing methodsFor: 'access'!
  1455.  
  1456. length
  1457.  
  1458.     ^length!
  1459.  
  1460. line
  1461.  
  1462.     ^line!
  1463.  
  1464. p1
  1465.  
  1466.     ^p1!
  1467.  
  1468. p1Force
  1469.  
  1470.     ^p1Force!
  1471.  
  1472. p2
  1473.  
  1474.     ^p2!
  1475.  
  1476. p2Force
  1477.  
  1478.     ^p2Force! !
  1479.  
  1480. !RodThing methodsFor: 'glyphs'!
  1481.  
  1482. selectableGlyphsInto: aSet
  1483.     "Only the selectable parts of my line are selectable."
  1484.  
  1485.     line selectableGlyphsInto: aSet.!
  1486.  
  1487. visibleGlyphsInto: aSet
  1488.     "Only the visible parts of my line are visible."
  1489.  
  1490.     line visibleGlyphsInto: aSet.! !
  1491. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1492.  
  1493. RodThing class
  1494.     instanceVariableNames: ''!
  1495.  
  1496.  
  1497. !RodThing class methodsFor: 'class initialization'!
  1498.  
  1499. initialize
  1500.     "RodThing initialize"
  1501.  
  1502.     self initializePrimitive.
  1503.     partIcon _ (Form
  1504.         extent: 16@16
  1505.         fromArray: #(0 0 6280 6600 6300 6280 6144 6144 6144 6144 6280 6300 6600 6280 0 0)
  1506.         offset: 0@0).
  1507.     explainText _ 'A RodThing is a stretchable, compressible rod of some nominal length that obeys Hooke''s law for springs. I compute the force vector for each of my endpoints (which is zero if I am neither stretched nor compressed).'.! !
  1508.  
  1509. RodThing initialize!
  1510.  
  1511. PrimitiveThing subclass: #ThreeWayOp
  1512.     instanceVariableNames: 'location opForm a b c '
  1513.     classVariableNames: ''
  1514.     poolDictionaries: ''
  1515.     category: 'Things-Private'!
  1516.  
  1517.  
  1518. !ThreeWayOp methodsFor: 'initialization'!
  1519.  
  1520. initializeStructure
  1521.  
  1522.     a _ Node cloneFor: self.
  1523.     b _ Node cloneFor: self.
  1524.     c _ Node cloneFor: self.
  1525.     location _ PointThing cloneFor: self.!
  1526.  
  1527. initializeValues
  1528.  
  1529.     self set: #a.location.x to: 20.
  1530.     self set: #a.location.y to: 20.
  1531.     self set: #b.location.x to: 20.
  1532.     self set: #b.location.y to: 50.
  1533.     self set: #c.location.x to: 80.
  1534.     self set: #c.location.y to: 30.
  1535.     self set: #location.x to: 50.
  1536.     self set: #location.y to: 30.
  1537.     self set: #opForm to:
  1538.         (Form
  1539.             extent: 9@9
  1540.             fromArray: #(65408 16640 40064 41600 33920 34944 32896 51584 32512)
  1541.             offset: -4@-4).! !
  1542.  
  1543. !ThreeWayOp methodsFor: 'glyphs'!
  1544.  
  1545. boundingBox
  1546.     "Answer a box around my opForm centered on my location."
  1547.  
  1548.     ^(location asPoint + opForm offset)
  1549.         extent: (opForm extent)!
  1550.  
  1551. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1552.  
  1553.     | line |
  1554.     line _ Line
  1555.         from: (location asPoint)
  1556.         to: 0@0    "filled in below"
  1557.         withForm: (Form extent: 1@1) black.
  1558.     (Array with: a with: b with: c) do:
  1559.         [: part |
  1560.          line endPoint: part location asPoint.
  1561.          line
  1562.             displayOn: aDisplayMedium
  1563.             at: aDisplayPoint
  1564.             clippingBox: clipBox
  1565.             rule: (Form paint)
  1566.             mask: (Form black)].
  1567.     opForm
  1568.         displayOn: aDisplayMedium
  1569.         at: (aDisplayPoint + location asPoint)
  1570.         clippingBox: clipBox
  1571.         rule: (Form over)
  1572.         mask: (Form black).!
  1573.  
  1574. glyphDependsOn
  1575.  
  1576.     ^Array
  1577.         with: self location
  1578.         with: a location
  1579.         with: b location
  1580.         with: c location!
  1581.  
  1582. selectableGlyphsInto: aSet
  1583.  
  1584.     a visibleGlyphsInto: aSet.
  1585.     b visibleGlyphsInto: aSet.
  1586.     c visibleGlyphsInto: aSet.
  1587.     aSet add: self.!
  1588.  
  1589. visibleGlyphsInto: aSet
  1590.  
  1591.     a visibleGlyphsInto: aSet.
  1592.     b visibleGlyphsInto: aSet.
  1593.     c visibleGlyphsInto: aSet.
  1594.     aSet add: self.! !
  1595.  
  1596. !ThreeWayOp methodsFor: 'access'!
  1597.  
  1598. a
  1599.  
  1600.     ^a!
  1601.  
  1602. b
  1603.  
  1604.     ^b!
  1605.  
  1606. c
  1607.  
  1608.     ^c!
  1609.  
  1610. location
  1611.  
  1612.     ^location!
  1613.  
  1614. opForm
  1615.  
  1616.     ^opForm!
  1617.  
  1618. primopForm: aForm
  1619.  
  1620.     opForm _ aForm.! !
  1621. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1622.  
  1623. ThreeWayOp class
  1624.     instanceVariableNames: ''!
  1625.  
  1626.  
  1627. !ThreeWayOp class methodsFor: 'class initialization'!
  1628.  
  1629. initialize
  1630.     "ThreeWayOp initialize"
  1631.  
  1632.     self initializePrimitive.
  1633.     partIcon _ (Form
  1634.         extent: 16@16
  1635.         fromArray: #(8184 16380 28686 59367 53235 52275 52787 50787 49347 49539 49155 49539 57735 28686 16380 8184)
  1636.         offset: 0@0).
  1637.     explainText _ 'A ThreeWayOp is a template Thing for three operand operators. It is used as a sub-part of other Things, rather than as a stand-alone Thing. It provides three Nodes and an operator Form.'.! !
  1638.  
  1639. ThreeWayOp initialize!
  1640.  
  1641. VScrollThing subclass: #VSliderThing
  1642.     instanceVariableNames: ''
  1643.     classVariableNames: ''
  1644.     poolDictionaries: ''
  1645.     category: 'Things-Primitive'!
  1646.  
  1647.  
  1648. !VSliderThing methodsFor: 'glyphs'!
  1649.  
  1650. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1651.     "Display my box and fill it with gray 'mercury' up to the marker."
  1652.  
  1653.     | myBox |
  1654.     myBox _ self boundingBox.
  1655.     myBox _ myBox insetBy: 1.
  1656.     myBox top: (self markerY max: myBox top).
  1657.     aDisplayMedium gray: (myBox moveBy: aDisplayPoint).
  1658.     super
  1659.         displayOn: aDisplayMedium
  1660.         at: aDisplayPoint
  1661.         clippingBox: clipBox.! !
  1662. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1663.  
  1664. VSliderThing class
  1665.     instanceVariableNames: ''!
  1666.  
  1667.  
  1668. !VSliderThing class methodsFor: 'class initialization'!
  1669.  
  1670. initialize
  1671.     "VSliderThing initialize"
  1672.  
  1673.     self initializePrimitive.
  1674.     partIcon _ (Form
  1675.         extent: 16@16
  1676.         fromArray: #(0 2016 1056 1056 1056 2016 1376 1696 1376 1696 1376 1696 1376 1696 1376 2016)
  1677.         offset: 0@0).
  1678.     explainText _ 'A VSliderThing is like a VScrollThing except that it draws "mercury" instead of just a horizontal marker.'.! !
  1679.  
  1680. VSliderThing initialize!
  1681.  
  1682. PrimitiveThing subclass: #WireThing
  1683.     instanceVariableNames: 'node1 node2 line '
  1684.     classVariableNames: ''
  1685.     poolDictionaries: ''
  1686.     category: 'Things-Primitive'!
  1687.  
  1688.  
  1689. !WireThing methodsFor: 'initialization'!
  1690.  
  1691. initializeConstraints
  1692.     "WireThing initialize"
  1693.  
  1694.     "the values of my terminals are required to be equal"
  1695.     self require: #node1.value equals: #node2.value.
  1696.  
  1697.     "layout"
  1698.     self require: #node1.location.x equals: #line.p1.x.
  1699.     self require: #node1.location.y equals: #line.p1.y.
  1700.     self require: #node2.location.x equals: #line.p2.x.
  1701.     self require: #node2.location.y equals: #line.p2.y.!
  1702.  
  1703. initializeStructure
  1704.  
  1705.     node1 _ Node cloneFor: self.
  1706.     node2 _ Node cloneFor: self.
  1707.     line _ PlainLine cloneFor: self.!
  1708.  
  1709. initializeValues
  1710.  
  1711.     self set: #node1.location.x to: 10.
  1712.     self set: #node1.location.y to: 10.
  1713.     self set: #node2.location.x to: 30.
  1714.     self set: #node2.location.y to: 30.! !
  1715.  
  1716. !WireThing methodsFor: 'access'!
  1717.  
  1718. line
  1719.  
  1720.     ^line!
  1721.  
  1722. node1
  1723.  
  1724.     ^node1!
  1725.  
  1726. node2
  1727.  
  1728.     ^node2! !
  1729.  
  1730. !WireThing methodsFor: 'glyphs'!
  1731.  
  1732. selectableGlyphsInto: aSet
  1733.  
  1734.     node1 selectableGlyphsInto: aSet.
  1735.     node2 selectableGlyphsInto: aSet.!
  1736.  
  1737. visibleGlyphsInto: aSet
  1738.  
  1739.     node1 visibleGlyphsInto: aSet.
  1740.     node2 visibleGlyphsInto: aSet.
  1741.     aSet add: line.! !
  1742. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1743.  
  1744. WireThing class
  1745.     instanceVariableNames: ''!
  1746.  
  1747.  
  1748. !WireThing class methodsFor: 'class initialization'!
  1749.  
  1750. initialize
  1751.     "WireThing initialize"
  1752.  
  1753.     self initializePrimitive.
  1754.     partIcon _ (Form
  1755.         extent: 16@16
  1756.         fromArray: #(0 2080 4112 16376 4112 2080 0 49155 65535 49155 0 0 0 0 0 0)
  1757.         offset: 0@0).
  1758.     explainText _ 'A WireThing propagates Node values the way an electrical wire propogates voltages.'.! !
  1759.  
  1760. WireThing initialize!
  1761.  
  1762. PrimitiveThing subclass: #Sum
  1763.     instanceVariableNames: 'op '
  1764.     classVariableNames: ''
  1765.     poolDictionaries: ''
  1766.     category: 'Things-Primitive'!
  1767.  
  1768.  
  1769. !Sum methodsFor: 'initialization'!
  1770.  
  1771. initializeConstraints
  1772.     "Sum initialize"
  1773.  
  1774.     self stronglyPrefer: 'a + b = c'
  1775.         where: #((a op.a.value) (b op.b.value) (c op.c.value)).!
  1776.  
  1777. initializeStructure
  1778.  
  1779.     op _ ThreeWayOp cloneFor: self.!
  1780.  
  1781. initializeValues
  1782.  
  1783.     self set: #op.a.value to: 0.
  1784.     self set: #op.b.value to: 0.
  1785.     self set: #op.c.value to: 0.
  1786.     self set: #op.opForm to:
  1787.         (Form
  1788.             extent: 9@11
  1789.             fromArray: #(15872 16640 32896 34944 34944 48768 34944 34944 32896 16640 15872)
  1790.             offset: -4@-5).! !
  1791.  
  1792. !Sum methodsFor: 'access'!
  1793.  
  1794. op
  1795.  
  1796.     ^op! !
  1797. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1798.  
  1799. Sum class
  1800.     instanceVariableNames: ''!
  1801.  
  1802.  
  1803. !Sum class methodsFor: 'class initialization'!
  1804.  
  1805. initialize
  1806.     "Sum initialize"
  1807.  
  1808.     self initializePrimitive.
  1809.     partIcon _ Form
  1810.         extent: 16@16
  1811.         fromArray: #(8184 16380 28686 57351 49539 49539 49539 53235 53235 49539 49539 49539 57351 28686 16380 8184)
  1812.         offset: 0@0.
  1813.     explainText _ 'A Sum is a three operand arithmetic constraint, x + y = z'.! !
  1814.  
  1815. Sum initialize!
  1816.  
  1817. PrimitiveThing subclass: #PenRecorderThing
  1818.     instanceVariableNames: 'border scale offset input history '
  1819.     classVariableNames: ''
  1820.     poolDictionaries: ''
  1821.     category: 'Things-Primitive'!
  1822.  
  1823.  
  1824. !PenRecorderThing methodsFor: 'initialization'!
  1825.  
  1826. initializeConstraints
  1827.     "PenRecorderThing initialize"
  1828.  
  1829.     "layout constraints"
  1830.     self offset: #input.location.x by: 0 from: #border.center.x.
  1831.     self offset: #input.location.y by: 5 from: #border.bottomRight.y.!
  1832.  
  1833. initializeStructure
  1834.  
  1835.     border _ CenterRectThing cloneFor: self.
  1836.     scale _ Node cloneFor: self.
  1837.     offset _ Node cloneFor: self.
  1838.     input _ Node cloneFor: self.!
  1839.  
  1840. initializeValues
  1841.  
  1842.     self set: #border.topLeft.x to: 30.
  1843.     self set: #border.topLeft.y to: 30.    
  1844.     self set: #border.bottomRight.x to: 100.
  1845.     self set: #border.bottomRight.y to: 80.
  1846.     self set: #scale.value to: 1.
  1847.     self set: #offset.value to: 0.
  1848.     self set: #input.value to: 0.
  1849.     history _ (HistoryQueue new: 2000) clearTo: 0.! !
  1850.  
  1851. !PenRecorderThing methodsFor: 'access'!
  1852.  
  1853. border
  1854.  
  1855.     ^border!
  1856.  
  1857. history
  1858.  
  1859.     ^history!
  1860.  
  1861. input
  1862.  
  1863.     ^input!
  1864.  
  1865. offset
  1866.  
  1867.     ^offset!
  1868.  
  1869. scale
  1870.  
  1871.     ^scale! !
  1872.  
  1873. !PenRecorderThing methodsFor: 'glyphs'!
  1874.  
  1875. boundingBox
  1876.  
  1877.     ^border asRectangle!
  1878.  
  1879. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  1880.  
  1881.     | myBox xValue yCenter yScale pen yValue |
  1882.     myBox _ clipBox intersect: (border asRectangle moveBy: aDisplayPoint).
  1883.     xValue _ (myBox left + 1) rounded.
  1884.     yScale _ scale value negated asFloat.
  1885.     yCenter _ (myBox top + myBox bottom // 2) rounded +
  1886.                 (offset value negated asFloat * yScale) rounded.
  1887.     pen _ BitBlt
  1888.         destForm: aDisplayMedium
  1889.         sourceForm: ((Form extent: 1@1) black)
  1890.         halftoneForm: nil
  1891.         combinationRule: (Form over)
  1892.         destOrigin: 0@0
  1893.         sourceOrigin: 0@0
  1894.         extent: 1@1
  1895.         clipRect: myBox.
  1896.     history last: ((myBox width - 2) rounded) do:
  1897.         [: value |
  1898.          yValue _ (value asFloat * yScale) rounded + yCenter.
  1899.          ((yValue > myBox top) & (yValue < myBox bottom)) ifTrue:
  1900.             [pen destX: xValue.
  1901.              pen destY: yValue.
  1902.              pen copyBits].
  1903.          xValue _ xValue + 1].!
  1904.  
  1905. glyphDependsOn
  1906.  
  1907.     ^(Array
  1908.         with: border topLeft
  1909.         with: border bottomRight),
  1910.       (Array
  1911.         with: scale
  1912.         with: offset
  1913.         with: input)!
  1914.  
  1915. location
  1916.  
  1917.     ^border topLeft!
  1918.  
  1919. selectableGlyphsInto: aSet
  1920.  
  1921.     input selectableGlyphsInto: aSet.
  1922.     aSet add: border topLeft.
  1923.     aSet add: border bottomRight.!
  1924.  
  1925. visibleGlyphsInto: aSet
  1926.  
  1927.     border visibleGlyphsInto: aSet.
  1928.     input visibleGlyphsInto: aSet.
  1929.     aSet add: self.! !
  1930.  
  1931. !PenRecorderThing methodsFor: 'history'!
  1932.  
  1933. advanceHistory
  1934.  
  1935.     history add: input value.!
  1936.  
  1937. keepsHistory
  1938.  
  1939.     ^true! !
  1940. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1941.  
  1942. PenRecorderThing class
  1943.     instanceVariableNames: ''!
  1944.  
  1945.  
  1946. !PenRecorderThing class methodsFor: 'class initialization'!
  1947.  
  1948. initialize
  1949.     "PenRecorderThing initialize"
  1950.  
  1951.     self initializePrimitive.
  1952.     partIcon _ (Form
  1953.         extent: 16@16
  1954.         fromArray: #(65535 32769 32769 33281 34049 34945 61511 32809 32785 32769 32769 32769 65535 384 384 0)
  1955.         offset: 0@0).
  1956.     explainText _ 'A PenRecorderThing records and display the last N values of its input, like an oscilloscope. The vertical scale and offset are adjustable.'.! !
  1957.  
  1958. PenRecorderThing initialize!
  1959.  
  1960. PrimitiveThing subclass: #BasicTextThing
  1961.     instanceVariableNames: 'box node '
  1962.     classVariableNames: ''
  1963.     poolDictionaries: ''
  1964.     category: 'Things-Private'!
  1965.  
  1966.  
  1967. !BasicTextThing methodsFor: 'initialization'!
  1968.  
  1969. initializeStructure
  1970.  
  1971.     box _ FixedRectThing cloneFor: self.
  1972.     node _ Node cloneFor: self.!
  1973.  
  1974. initializeValues
  1975.  
  1976.     self set: #box.extent.x to: 30.
  1977.     self set: #box.extent.y to: 15.
  1978.     self set: #node.location.x to: 25.
  1979.     self set: #node.location.y to: 30.
  1980.     self set: #node.value to: 'Text'.! !
  1981.  
  1982. !BasicTextThing methodsFor: 'access'!
  1983.  
  1984. box
  1985.  
  1986.     ^box!
  1987.  
  1988. displayText
  1989.     "Answer the text to be displayed. Subclasses may override this behavior."
  1990.  
  1991.     ^node value!
  1992.  
  1993. node
  1994.  
  1995.     ^node! !
  1996.  
  1997. !BasicTextThing methodsFor: 'glyphs'!
  1998.  
  1999. boundingBox
  2000.     "Answer the box for my text."
  2001.  
  2002.     ^box asRectangle!
  2003.  
  2004. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  2005.     "Print my text at my position."
  2006.  
  2007.     | textBox scanner |
  2008.     textBox _ box asRectangle moveBy: aDisplayPoint.
  2009.     aDisplayMedium white: ((textBox  insetBy: 1) intersect: clipBox).
  2010.     scanner _ QuickPrint
  2011.         newOn: aDisplayMedium
  2012.         box: (textBox insetBy: 2).
  2013.     scanner drawString: self displayText.!
  2014.  
  2015. glyphDependsOn
  2016.  
  2017.     ^Array
  2018.         with: box topLeft
  2019.         with: box bottomRight
  2020.         with: node!
  2021.  
  2022. inputGlyphsInto: aSet
  2023.  
  2024.     aSet add: self.!
  2025.  
  2026. location
  2027.  
  2028.     ^box topLeft!
  2029.  
  2030. selectableGlyphsInto: aSet
  2031.  
  2032.     aSet add: node; add: self.!
  2033.  
  2034. visibleGlyphsInto: aSet
  2035.  
  2036.     aSet add: node; add: box; add: self.! !
  2037.  
  2038. !BasicTextThing methodsFor: 'keyboard'!
  2039.  
  2040. handleKeystroke: aCharacter view: aView
  2041.     "Append the given character to my text. If the character is backspace, delete my character."
  2042.  
  2043.     ((aCharacter == Character backspace) & (node value size > 0))
  2044.         ifTrue:
  2045.             [node primvalue:
  2046.                 (node value copyFrom: 1 to: (node value size - 1)).
  2047.              (node value isEmpty) ifTrue: [node primvalue: ' '].
  2048.              ^self].
  2049.  
  2050.     (node value == ' ')
  2051.         ifTrue: [node primvalue: (String with: aCharacter)]
  2052.         ifFalse: [node primvalue: (node value copyWith: aCharacter)].!
  2053.  
  2054. keystrokeConstraints
  2055.  
  2056.     ^Array with: (
  2057.         EditConstraint
  2058.             ref:     node->#value
  2059.             strength: ThingLabII editStrength)!
  2060.  
  2061. wantsKeystrokes
  2062.  
  2063.     ^true! !
  2064. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2065.  
  2066. BasicTextThing class
  2067.     instanceVariableNames: ''!
  2068.  
  2069.  
  2070. !BasicTextThing class methodsFor: 'class initialization'!
  2071.  
  2072. initialize
  2073.     "BasicTextThing initialize"
  2074.  
  2075.     self initializePrimitive.
  2076.     partIcon _ (Form
  2077.         extent: 16@16
  2078.         fromArray: #(0 65535 0 0 4559 14633 27944 17864 32040 17705 17871 0 0 65535 0 0)
  2079.         offset: 0@0).
  2080.     explainText _ 'A BasicTextThing holds an editable string in a resizable box plus a node containing the string to be displayed.'.! !
  2081.  
  2082. BasicTextThing initialize!
  2083.  
  2084. PrimitiveThing subclass: #HistorySplitter
  2085.     instanceVariableNames: 'op '
  2086.     classVariableNames: ''
  2087.     poolDictionaries: ''
  2088.     category: 'Things-Primitive'!
  2089.  
  2090.  
  2091. !HistorySplitter methodsFor: 'initialization'!
  2092.  
  2093. initializeConstraints
  2094.     "HistorySplitter initialize"
  2095.  
  2096.     self stronglyPreferEdit: #op.c.last.
  2097.     self require: #op.b.value equals: #op.c.value.
  2098.     self methods: #('outA _ last')
  2099.         where: #((outA op.a.value) (last op.c.last))
  2100.         strength: #required.
  2101.  
  2102.     "layout constraints"
  2103.     self offset: #op.a.location.x by: -5 from: #op.location.x.
  2104.     self offset: #op.a.location.y by: -7 from: #op.location.y.
  2105.     self offset: #op.b.location.x by: 5 from: #op.location.x.
  2106.     self offset: #op.b.location.y by: -7 from: #op.location.y.
  2107.     self offset: #op.c.location.x by: 0 from: #op.location.x.
  2108.     self offset: #op.c.location.y by: 6 from: #op.location.y.!
  2109.  
  2110. initializeStructure
  2111.  
  2112.     op _ ThreeWayOp cloneFor: self.!
  2113.  
  2114. initializeValues
  2115.  
  2116.     self set: #op.a.value to: 0.
  2117.     self set: #op.b.value to: 0.
  2118.     self set: #op.c.value to: 0.
  2119.     self set: #op.c.location.x to: 25.
  2120.     self set: #op.c.location.y to: 25.
  2121.     self set: #op.opForm to:
  2122.         (Form
  2123.             extent: 19@9
  2124.             fromArray: #(65535 57344 32832 8192 36943 8192 36937 8192 36936 8192 36937 8192 40527 8192 32832 8192 65535 57344)
  2125.             offset: -10@-5).! !
  2126.  
  2127. !HistorySplitter methodsFor: 'access'!
  2128.  
  2129. op
  2130.  
  2131.     ^op! !
  2132. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2133.  
  2134. HistorySplitter class
  2135.     instanceVariableNames: ''!
  2136.  
  2137.  
  2138. !HistorySplitter class methodsFor: 'class initialization'!
  2139.  
  2140. initialize
  2141.     "HistorySplitter initialize"
  2142.  
  2143.     self initializePrimitive.
  2144.     partIcon _ (Form
  2145.         extent: 16@16
  2146.         fromArray: #(0 0 0 6192 65534 33026 41338 41290 41282 41290 48506 33026 65534 896 0 0)
  2147.         offset: 0@0).
  2148.     explainText _ 'A HistorySplitter splits the value of a node into its current and previous values.'.! !
  2149.  
  2150. HistorySplitter initialize!
  2151.  
  2152. PrimitiveThing subclass: #FormPrinter
  2153.     instanceVariableNames: 'location node '
  2154.     classVariableNames: 'BitColor PenForm '
  2155.     poolDictionaries: ''
  2156.     category: 'Things-Primitive'!
  2157. FormPrinter comment:
  2158. 'This is a direct copy of NumberPrinter as of 18-Jan-89 modified to handle Forms rather than numbers.  The modification and bitEditing code was added by Bjorn Freeman-Benson.
  2159.  
  2160. Some changes: the box is autosizing.'!
  2161.  
  2162.  
  2163. !FormPrinter methodsFor: 'initialization'!
  2164.  
  2165. initializeStructure
  2166.  
  2167.     location _ PointThing cloneFor: self.
  2168.     node _ Node cloneFor: self.!
  2169.  
  2170. initializeValues
  2171.  
  2172.     self set: #location.x to: 30.
  2173.     self set: #location.y to: 20.    
  2174.     self set: #node.location.x to: 60.
  2175.     self set: #node.location.y to: 60.    
  2176.     self set: #node.value to: (Form extent: 30@20).! !
  2177.  
  2178. !FormPrinter methodsFor: 'access'!
  2179.  
  2180. location
  2181.  
  2182.     ^location!
  2183.  
  2184. node
  2185.  
  2186.     ^node! !
  2187.  
  2188. !FormPrinter methodsFor: 'glyphs'!
  2189.  
  2190. boundingBox
  2191.     "Answer a box around my form display box centered on my location."
  2192.  
  2193.     ^(self location asPoint - ((self node value extent + 2) // 2))
  2194.         extent: (self node value extent + 2)!
  2195.  
  2196. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  2197.     "Display my display box, print my node's value inside it, and draw a line from my display box to my node."
  2198.  
  2199.     | form extent |
  2200.     extent _ self node value extent + (2@2).
  2201.     form _ Form extent: extent.
  2202.     form border: ((0@0) extent: extent) width: 1.
  2203.     (Line
  2204.         from: (location asPoint)
  2205.         to: (node location asPoint)
  2206.         withForm: PenForm)
  2207.             displayOn: aDisplayMedium
  2208.             at: aDisplayPoint
  2209.             clippingBox: clipBox
  2210.             rule: (Form paint)
  2211.             mask: (Form black).
  2212.     form
  2213.         displayOn: aDisplayMedium
  2214.         at: (aDisplayPoint + (location asPoint) - (extent // 2))
  2215.         clippingBox: clipBox
  2216.         rule: (Form over)
  2217.         mask: (Form black).
  2218.     self node value
  2219.         displayOn: aDisplayMedium
  2220.         at: ((aDisplayPoint + (location asPoint) - (extent // 2)) + (1@1))
  2221.         clippingBox: clipBox
  2222.         rule: (Form over)
  2223.         mask: (Form black).!
  2224.  
  2225. glyphDependsOn
  2226.  
  2227.     ^Array
  2228.         with: self location
  2229.         with: node location
  2230.         with: node!
  2231.  
  2232. inputGlyphsInto: aSet
  2233.     "I accept input."
  2234.  
  2235.     aSet add: self.!
  2236.  
  2237. visibleGlyphsInto: aSet
  2238.     "I consists of a NumberNode, my display box, and a line segment connecting them."
  2239.  
  2240.     aSet add: node; add: self.! !
  2241.  
  2242. !FormPrinter methodsFor: 'mouse'!
  2243.  
  2244. calculateMousePoint: mousePoint
  2245.  
  2246.     ^mousePoint - self location asPoint + (self node value extent // 2)!
  2247.  
  2248. handleMouseDown: mousePoint view: aView
  2249.  
  2250.     (Sensor leftShiftDown)
  2251.         ifTrue:
  2252.             [^NotifyingBitEditor openOnForm: (node value) client: aView controller]
  2253.         ifFalse:
  2254.             [BitColor _ (((self node value)
  2255.                 valueAt: (self calculateMousePoint: mousePoint)) == 1)
  2256.                     ifTrue: [0]
  2257.                     ifFalse: [1].
  2258.              self handleMouseMove: mousePoint view: aView].!
  2259.  
  2260. handleMouseMove: mousePoint view: aView
  2261.  
  2262.     (self node value)
  2263.         valueAt: (self calculateMousePoint: mousePoint)
  2264.         put: BitColor!
  2265.  
  2266. mouseConstraints
  2267.  
  2268.     ^Array with: (
  2269.         EditConstraint
  2270.             ref:     node->#value
  2271.             strength: ThingLabII editStrength)!
  2272.  
  2273. wantsMouse
  2274.  
  2275.     ^true! !
  2276. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2277.  
  2278. FormPrinter class
  2279.     instanceVariableNames: ''!
  2280.  
  2281.  
  2282. !FormPrinter class methodsFor: 'class initialization'!
  2283.  
  2284. initialize
  2285.     "FormPrinter initialize"
  2286.  
  2287.     self initializePrimitive.
  2288.     partIcon _ (Form
  2289.         extent: 16@16
  2290.         fromArray: #(65535 32769 32769 34401 34401 32769 32769 34833 34785 32769 65535 256 256 896 896 896)
  2291.         offset: 0@0).
  2292.     explainText _ 'A FormPrinter shows a Smalltalk Form in a box. The Form can be edited using the yellow (option-mouse) button hack.'.
  2293.     PenForm _ (Form extent: 1@1) black.! !
  2294.  
  2295. FormPrinter initialize!
  2296.  
  2297. VScrollThing subclass: #VScrollThingMinusNodes
  2298.     instanceVariableNames: ''
  2299.     classVariableNames: ''
  2300.     poolDictionaries: ''
  2301.     category: 'Things-MinusNodes'!
  2302.  
  2303.  
  2304. !VScrollThingMinusNodes methodsFor: 'glyphs'!
  2305.  
  2306. selectableGlyphsInto: aSet!
  2307.  
  2308. visibleGlyphsInto: aSet
  2309.  
  2310.     aSet add: box; add: self.! !
  2311. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2312.  
  2313. VScrollThingMinusNodes class
  2314.     instanceVariableNames: ''!
  2315.  
  2316.  
  2317. !VScrollThingMinusNodes class methodsFor: 'class initialization'!
  2318.  
  2319. initialize
  2320.     "VScrollThingMinusNodes initialize"
  2321.  
  2322.     super initialize.
  2323.     explainText _ 'I am like a VScrollThing except that my connection points are hidden.'.! !
  2324.  
  2325. VScrollThingMinusNodes initialize!
  2326.  
  2327. PrimitiveThing subclass: #ScrollingListThing
  2328.     instanceVariableNames: 'box scrollBar itemsList selectedItem '
  2329.     classVariableNames: ''
  2330.     poolDictionaries: ''
  2331.     category: 'Things-Primitive'!
  2332.  
  2333.  
  2334. !ScrollingListThing methodsFor: 'initialization'!
  2335.  
  2336. initializeConstraints
  2337.     "ScrollingListThing initialize"
  2338.  
  2339.     self stronglyPreferEdit:#selectedItem.last.
  2340.     self methods: #(
  2341.             'selected _ (items includes: oldSelected)
  2342.                 ifTrue: [oldSelected]
  2343.                 ifFalse: [nil]')
  2344.         where: #((selected selectedItem.value) (items itemsList.value)
  2345.                  (oldSelected selectedItem.last))
  2346.         strength: #default.
  2347.  
  2348.     "layout"
  2349.     self offset: #scrollBar.box.topLeft.x by: -8 from: #box.topLeft.x.
  2350.     self offset: #scrollBar.box.topLeft.y by: 0 from: #box.topLeft.y.
  2351.     self offset: #scrollBar.box.extent.y by: 0 from: #box.extent.y.
  2352.  
  2353.     self offset: #itemsList.location.x by: -10 from: #box.topLeft.x.
  2354.     self offset: #itemsList.location.y by: -5 from: #box.center.y.
  2355.  
  2356.     self offset: #selectedItem.location.x by: -10 from: #box.topLeft.x.
  2357.     self offset: #selectedItem.location.y by: 5 from: #box.center.y.!
  2358.  
  2359. initializeStructure
  2360.  
  2361.     box _ CenterRectThing cloneFor: self.
  2362.     scrollBar _ VScrollThingMinusNodes cloneFor: self.
  2363.     itemsList _ Node cloneFor: self.
  2364.     selectedItem _ Node cloneFor: self.!
  2365.  
  2366. initializeValues
  2367.  
  2368.     self set: #box.bottomRight.x to: 85.
  2369.     self set: #box.bottomRight.y to: 60.
  2370.  
  2371.     self set: #scrollBar.box.extent.x to: 9.
  2372.     self set: #scrollBar.box.topLeft.x to: 20.
  2373.     self set: #scrollBar.box.topLeft.y to: 20.
  2374.     self set: #scrollBar.minVal to: 0.0.
  2375.     self set: #scrollBar.maxVal to: 1.0.
  2376.     self set: #scrollBar.node.value to: 1.0.
  2377.  
  2378.     self set: #itemsList.value to: #(apple pear peach kumqwat).
  2379.  
  2380.     self set: #selectedItem.value to: nil.
  2381.     self set: #selectedItem.last to: nil.! !
  2382.  
  2383. !ScrollingListThing methodsFor: 'access'!
  2384.  
  2385. box
  2386.  
  2387.     ^box!
  2388.  
  2389. itemsList
  2390.  
  2391.     ^itemsList!
  2392.  
  2393. primitemsList: aListOfStrings
  2394.  
  2395.     itemsList _ aListOfStrings.!
  2396.  
  2397. primselectedItem: aString
  2398.  
  2399.     selectedItem _ aString.!
  2400.  
  2401. scrollBar
  2402.  
  2403.     ^scrollBar!
  2404.  
  2405. selectedItem
  2406.  
  2407.     ^selectedItem! !
  2408.  
  2409. !ScrollingListThing methodsFor: 'glyphs'!
  2410.  
  2411. boundingBox
  2412.  
  2413.     ^box asRectangle!
  2414.  
  2415. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  2416.     "Print my items in my box and highlight the selected item, if any."
  2417.  
  2418.     | itemsBox lineHeight left y thisItemBox index highLightBox items |
  2419.     items _ self visibleItems.
  2420.     itemsBox _ (self boundingBox moveBy: aDisplayPoint) insetBy: 2.
  2421.     lineHeight _ QuickPrint lineHeight.
  2422.     left _ itemsBox left.
  2423.     y _ itemsBox top.
  2424.     items do:
  2425.         [: item |
  2426.          thisItemBox _ ((left + 1)@y) corner: itemsBox bottomRight.
  2427.          (QuickPrint
  2428.             newOn: aDisplayMedium
  2429.             box: thisItemBox) drawString: item asString.
  2430.          y _ y + lineHeight].
  2431.  
  2432.     index _ items indexOf: (selectedItem value) ifAbsent: [0].
  2433.     ((index > 0) & (index <= items size)) ifTrue:
  2434.         [highLightBox _
  2435.             (left@(itemsBox top + (lineHeight * (index - 1))))
  2436.                 extent: (itemsBox width@lineHeight).
  2437.          highLightBox _ highLightBox intersect: itemsBox.
  2438.          aDisplayMedium reverse: highLightBox].!
  2439.  
  2440. glyphDependsOn
  2441.  
  2442.     ^(Array
  2443.         with: self
  2444.         with: box topLeft
  2445.         with: box bottomRight),
  2446.      (Array with: selectedItem)!
  2447.  
  2448. inputGlyphsInto: aSet
  2449.  
  2450.     aSet add: scrollBar.
  2451.     aSet add: self.!
  2452.  
  2453. selectableGlyphsInto: aSet
  2454.  
  2455.     aSet add: box bottomRight.
  2456.     aSet add: scrollBar box topLeft.
  2457.     aSet add: itemsList.
  2458.     aSet add: selectedItem.!
  2459.  
  2460. visibleGlyphsInto: aSet
  2461.  
  2462.     aSet add: self; add: box.
  2463.     aSet add: scrollBar; add: scrollBar box.
  2464.     aSet add: itemsList.
  2465.     aSet add: selectedItem.!
  2466.  
  2467. visibleItems
  2468.     "Answer the subset of my itemsList which are currently visible."
  2469.  
  2470.     | items itemCount visibleCount max first |
  2471.     items _ itemsList value.
  2472.     itemCount _ items size.
  2473.     visibleCount _ (box extent y // QuickPrint lineHeight) min: itemCount.
  2474.     max _ (itemCount - visibleCount) max: 0.
  2475.     first _ 1 + ((1.0 - scrollBar node value) * max) rounded.
  2476.     "Assertion: first+visibleCount-1 <= itemCount"
  2477.     ^items copyFrom: first to: (first + visibleCount - 1)! !
  2478.  
  2479. !ScrollingListThing methodsFor: 'mouse'!
  2480.  
  2481. handleMouseMove: mousePoint view: aView
  2482.  
  2483.     | myBox index items selected |
  2484.     myBox _ box asRectangle.
  2485.     items _ self visibleItems.
  2486.     (myBox containsPoint: mousePoint)
  2487.         ifTrue:
  2488.             [index _
  2489.                 ((mousePoint y - myBox top) // QuickPrint lineHeight) + 1.
  2490.              ((index <= items size) and: [(items at: index) ~= ''])
  2491.                 ifTrue: [selected _ (items at: index)]
  2492.                 ifFalse: [selected _ nil]]
  2493.         ifFalse: [selected _ nil].
  2494.     selectedItem primvalue: selected.!
  2495.  
  2496. mouseConstraints
  2497.  
  2498.     ^Array with: (
  2499.         EditConstraint
  2500.             ref:     selectedItem->#value
  2501.             strength: ThingLabII editStrength)!
  2502.  
  2503. wantsMouse
  2504.  
  2505.     ^true! !
  2506. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2507.  
  2508. ScrollingListThing class
  2509.     instanceVariableNames: ''!
  2510.  
  2511.  
  2512. !ScrollingListThing class methodsFor: 'class initialization'!
  2513.  
  2514. initialize
  2515.     "ScrollingListThing initialize"
  2516.  
  2517.     self initializePrimitive.
  2518.     partIcon _ (Form
  2519.         extent: 16@16
  2520.         fromArray: #(65532 32774 49142 32774 49142 32774 65534 61502 65534 32774 49142 32774 49142 32774 65534 32766)
  2521.         offset: 0@0).
  2522.     explainText _ 'A ScrollingListThing consists of a scroll bar, a menu Thing, and nodes to hold the list of menu items (itemsList) and the selected item (selectedItem). It also has several variables that it uses internally such as the visible item count and the index of the first item to display.'.! !
  2523.  
  2524. ScrollingListThing initialize!
  2525.  
  2526. ScrollingListThing subclass: #ScrollingListThingMinusNodes
  2527.     instanceVariableNames: ''
  2528.     classVariableNames: ''
  2529.     poolDictionaries: ''
  2530.     category: 'Things-MinusNodes'!
  2531.  
  2532.  
  2533. !ScrollingListThingMinusNodes methodsFor: 'glyphs'!
  2534.  
  2535. selectableGlyphsInto: aSet
  2536.  
  2537.     aSet add: box bottomRight.
  2538.     aSet add: scrollBar box topLeft.!
  2539.  
  2540. visibleGlyphsInto: aSet
  2541.  
  2542.     aSet add: self; add: box.
  2543.     aSet add: scrollBar; add: scrollBar box.! !
  2544. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2545.  
  2546. ScrollingListThingMinusNodes class
  2547.     instanceVariableNames: ''!
  2548.  
  2549.  
  2550. !ScrollingListThingMinusNodes class methodsFor: 'class initialization'!
  2551.  
  2552. initialize
  2553.     "ScrollingListThingMinusNodes initialize"
  2554.  
  2555.     super initialize.
  2556.     explainText _ 'I am like a ScrollingListThing except that my connection points are hidden.'.! !
  2557.  
  2558. ScrollingListThingMinusNodes initialize!
  2559.  
  2560. TrebleClefThing subclass: #BassClefThing
  2561.     instanceVariableNames: ''
  2562.     classVariableNames: ''
  2563.     poolDictionaries: ''
  2564.     category: 'Things-Primitive'!
  2565.  
  2566.  
  2567. !BassClefThing methodsFor: 'initialization'!
  2568.  
  2569. initializeValues
  2570.  
  2571.     self set: #location.x to: 20.
  2572.     self set: #location.y to: 40.
  2573.     self set: #middleCOffset to: -5.
  2574.     self set: #width to: 200.! !
  2575.  
  2576. !BassClefThing methodsFor: 'glyphs'!
  2577.  
  2578. form
  2579.  
  2580.     ^Form
  2581.         extent: 14@17
  2582.         fromArray: #(7936 9088 16844 49388 61664 63712 63712 28908 236 192 448 384 768 1536 3072 6144 24576)
  2583.         offset: 6@0! !
  2584. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2585.  
  2586. BassClefThing class
  2587.     instanceVariableNames: ''!
  2588.  
  2589.  
  2590. !BassClefThing class methodsFor: 'class initialization'!
  2591.  
  2592. initialize
  2593.     "BassClefThing initialize"
  2594.  
  2595.     self initializePrimitive.
  2596.     partIcon _ (Form
  2597.         extent: 16@16
  2598.         fromArray: #(3968 4544 8422 24694 30832 31856 31856 14454 118 96 96 192 384 768 1536 3072)
  2599.         offset: 0@0).
  2600.     explainText _ 'A BassClefThing is a staff with a built in bass clef. See the comment for TrebleClefThing for further details.'.! !
  2601.  
  2602. BassClefThing initialize!
  2603.  
  2604. BasicTextThing subclass: #NumberText
  2605.     instanceVariableNames: ''
  2606.     classVariableNames: ''
  2607.     poolDictionaries: ''
  2608.     category: 'Things-Private'!
  2609.  
  2610.  
  2611. !NumberText methodsFor: 'initialization'!
  2612.  
  2613. initializeValues
  2614.  
  2615.     self set: #box.extent.x to: 46.
  2616.     self set: #box.extent.y to: 15.
  2617.     self set: #node.location.x to: 33.
  2618.     self set: #node.location.y to: 28.
  2619.     self set: #node.value to: 0.! !
  2620.  
  2621. !NumberText methodsFor: 'access'!
  2622.  
  2623. displayText
  2624.     "Answer the text to be displayed."
  2625.  
  2626.     ^node value printString! !
  2627.  
  2628. !NumberText methodsFor: 'keyboard'!
  2629.  
  2630. handleKeystroke: aCharacter view: aView
  2631.     "Accept the given character. If it is a digit, update myself. If it is backspace, delete my last digit, if any. If it is a minus sign, change my sign."
  2632.  
  2633.     | value valueString |
  2634.     value _ node value.
  2635.     valueString _ node value printString.
  2636.     (value respondsTo: #even) ifFalse:
  2637.         [value _ 0. valueString _ '0'].    "if value isn't a number, make it zero"
  2638.     ((value isInteger not) and: [value fractionPart = 0.0]) ifTrue:
  2639.         [valueString _ valueString copyFrom: 1 to: (valueString size - 1)].
  2640.     (aCharacter == Character backspace)
  2641.         ifTrue: [valueString _ valueString copyFrom: 1 to: (valueString size - 1)]
  2642.         ifFalse: [((aCharacter == $.) & (value isInteger))
  2643.             ifTrue: [valueString _ value asFloat printString]
  2644.             ifFalse: [(aCharacter == $-)
  2645.                 ifTrue: [valueString _ value negated printString]
  2646.                 ifFalse: [valueString _ valueString copyWith: aCharacter]]].
  2647.     node primvalue: valueString asNumber.! !
  2648. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2649.  
  2650. NumberText class
  2651.     instanceVariableNames: ''!
  2652.  
  2653.  
  2654. !NumberText class methodsFor: 'class initialization'!
  2655.  
  2656. initialize
  2657.     "NumberText initialize"
  2658.  
  2659.     self initializePrimitive.
  2660.     partIcon _ (Form
  2661.         extent: 16@16
  2662.         fromArray: #(0 65535 0 0 4492 12882 4162 4236 4354 4626 15308 0 0 65535 0 0)
  2663.         offset: 0@0).
  2664.     explainText _ 'A NumberText is like a BasicTextThing except that it parses numbers on keyboard entry and stores the resulting numeric value in its node rather than the string itself.'.! !
  2665.  
  2666. NumberText initialize!
  2667.  
  2668. PrimitiveThing subclass: #NumberPrinter
  2669.     instanceVariableNames: 'numberText line '
  2670.     classVariableNames: ''
  2671.     poolDictionaries: ''
  2672.     category: 'Things-Primitive'!
  2673.  
  2674.  
  2675. !NumberPrinter methodsFor: 'initialization'!
  2676.  
  2677. initializeConstraints
  2678.     "NumberPrinter initialize"
  2679.  
  2680.     "layout"
  2681.     self require: #numberText.node.location.x equals: #line.p1.x.
  2682.     self require: #numberText.node.location.y equals: #line.p1.y.
  2683.     self require: #numberText.box.center.x equals: #line.p2.x.
  2684.     self require: #numberText.box.center.y equals: #line.p2.y.!
  2685.  
  2686. initializeStructure
  2687.  
  2688.     numberText _ NumberText cloneFor: self.
  2689.     line _ PlainLine cloneFor: self.!
  2690.  
  2691. initializeValues
  2692.  
  2693.     self set: #numberText.box.center.x to: 35.
  2694.     self set: #numberText.box.center.y to: 20.
  2695.     self set: #numberText.node.location.x to: 60.
  2696.     self set: #numberText.node.location.y to: 60.! !
  2697.  
  2698. !NumberPrinter methodsFor: 'access'!
  2699.  
  2700. line
  2701.  
  2702.     ^line!
  2703.  
  2704. numberText
  2705.  
  2706.     ^numberText! !
  2707.  
  2708. !NumberPrinter methodsFor: 'glyphs'!
  2709.  
  2710. selectableGlyphsInto: aSet
  2711.  
  2712.     numberText selectableGlyphsInto: aSet.!
  2713.  
  2714. visibleGlyphsInto: aSet
  2715.  
  2716.     aSet add: line.
  2717.     numberText visibleGlyphsInto: aSet.! !
  2718. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2719.  
  2720. NumberPrinter class
  2721.     instanceVariableNames: ''!
  2722.  
  2723.  
  2724. !NumberPrinter class methodsFor: 'class initialization'!
  2725.  
  2726. initialize
  2727.     "NumberPrinter initialize"
  2728.  
  2729.     self initializePrimitive.
  2730.     partIcon _ (Form
  2731.         extent: 16@16
  2732.         fromArray: #(65535 32769 41753 42149 41093 41241 41477 42021 42905 32769 65535 256 256 896 896 896)
  2733.         offset: 0@0).
  2734.     explainText _ 'A NumberPrinter is a numeric value holder that prints its contents in a box. The value may be edited by typing digits, backspaces, the decimal point, and/or the minus sign while the NumberPrinter is selected.'.! !
  2735.  
  2736. NumberPrinter initialize!
  2737.  
  2738. PrimitiveThing subclass: #OrbitThing
  2739.     instanceVariableNames: 'center satellite theta radius rate '
  2740.     classVariableNames: ''
  2741.     poolDictionaries: ''
  2742.     category: 'Things-Primitive'!
  2743.  
  2744.  
  2745. !OrbitThing methodsFor: 'initialization'!
  2746.  
  2747. initializeConstraints
  2748.     "OrbitThing initialize"
  2749.  
  2750.     self defaultStay: #radius.node.value.
  2751.     self defaultStay: #rate.node.value.
  2752.  
  2753.     "incrementing theta"
  2754.     self stronglyPreferEdit:#theta.last.
  2755.     self require: 'newTheta = ((oldTheta + delta) \\ 360)'
  2756.         where: #((newTheta theta.value)
  2757.                  (oldTheta theta.last)
  2758.                  (delta rate.node.value)).
  2759.  
  2760.     "moving the satellite"
  2761.     self methods: #(
  2762.             'satX _ centerX + (radius * (theta degreesToRadians cos)).
  2763.              satY _ centerY + (radius * (theta degreesToRadians sin))')
  2764.         where: #((satX satellite.x) (satY satellite.y)
  2765.                   (centerX center.x) (centerY center.y)
  2766.                   (radius radius.node.value) (theta theta.value))
  2767.         strength: #preferred.
  2768.  
  2769.     "layout"
  2770.     self offset: #radius.box.topLeft.x by: 0 from: #rate.box.topLeft.x.
  2771.     self offset: #rate.box.topLeft.y by: 0 from: #radius.box.bottomRight.y.!
  2772.  
  2773. initializeStructure
  2774.  
  2775.     center _ PointThing cloneFor: self.
  2776.     satellite _ PointThing cloneFor: self.
  2777.     theta _ Node cloneFor: self.
  2778.     radius _ NumberText cloneFor: self.
  2779.     rate _ NumberText cloneFor: self.!
  2780.  
  2781. initializeValues
  2782.  
  2783.     self set: #center.x to: 60.
  2784.     self set: #center.y to: 40.
  2785.     self set: #theta.value to: 0.
  2786.     self set: #theta.last to: 0.
  2787.     self set: #radius.box.topLeft.x to: 10.
  2788.     self set: #radius.box.topLeft.y to: 10.
  2789.     self set: #radius.node.value to: 15.        "radius"
  2790.     self set: #rate.box.topLeft.x to: 10.
  2791.     self set: #rate.box.topLeft.y to: 24. 
  2792.     self set: #rate.node.value to: 18.        "degrees/iteration"! !
  2793.  
  2794. !OrbitThing methodsFor: 'access'!
  2795.  
  2796. center
  2797.  
  2798.     ^center!
  2799.  
  2800. radius
  2801.  
  2802.     ^radius!
  2803.  
  2804. rate
  2805.  
  2806.     ^rate!
  2807.  
  2808. satellite
  2809.  
  2810.     ^satellite!
  2811.  
  2812. theta
  2813.  
  2814.     ^theta! !
  2815.  
  2816. !OrbitThing methodsFor: 'glyphs'!
  2817.  
  2818. selectableGlyphsInto: aSet
  2819.  
  2820.     aSet add: center; add: satellite.
  2821.     aSet add: radius; add: rate.!
  2822.  
  2823. visibleGlyphsInto: aSet
  2824.  
  2825.     aSet add: center; add: satellite.
  2826.     aSet add: radius box; add: radius.
  2827.     aSet add: rate box; add: rate.! !
  2828. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2829.  
  2830. OrbitThing class
  2831.     instanceVariableNames: ''!
  2832.  
  2833.  
  2834. !OrbitThing class methodsFor: 'class initialization'!
  2835.  
  2836. initialize
  2837.     "OrbitThing initialize"
  2838.  
  2839.     self initializePrimitive.
  2840.     partIcon _ (Form
  2841.         extent: 16@16
  2842.         fromArray: #(544 4104 0 16386 0 32768 1 384 33152 1 0 0 16398 14 4110 576)
  2843.         offset: 0@0).
  2844.     explainText _ 'An OrbitThing consists of two Points, a center and a satellite. It also has two NumberTexts for specifying the orbit radius and rate (the rate specifies how many degrees to increment theta each iteration).'.! !
  2845.  
  2846. OrbitThing initialize!
  2847.  
  2848. NumberText subclass: #NumberDisplayer
  2849.     instanceVariableNames: ''
  2850.     classVariableNames: ''
  2851.     poolDictionaries: ''
  2852.     category: 'Things-Primitive'!
  2853.  
  2854.  
  2855. !NumberDisplayer methodsFor: 'initialization'!
  2856.  
  2857. initializeConstraints
  2858.     "NumberDisplayer initialize"
  2859.  
  2860.     super initializeConstraints.
  2861.  
  2862.     "fix node to bottom, center of box"
  2863.     self offset: #node.location.x by: 0 from: #box.center.x.
  2864.     self offset: #node.location.y by: 2 from: #box.bottomRight.y.! !
  2865. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2866.  
  2867. NumberDisplayer class
  2868.     instanceVariableNames: ''!
  2869.  
  2870.  
  2871. !NumberDisplayer class methodsFor: 'class initialization'!
  2872.  
  2873. initialize
  2874.     "NumberDisplayer initialize"
  2875.  
  2876.     self initializePrimitive.
  2877.     partIcon _ (Form
  2878.         extent: 16@16
  2879.         fromArray: #(65535 32769 41753 42149 41093 41241 41477 42021 42905 32769 65535 384 384 0 0 0)
  2880.         offset: 0@0).
  2881.     explainText _ 'A NumberDisplayer consists of a fixed-size box for displaying the number plus a node to hold the number. The relative locations of the node and display box are fixed by constraints. A NumberDisplayer accepts the keyboard input of numbers just like a NumberPrinter.'.! !
  2882.  
  2883. NumberDisplayer initialize!
  2884.  
  2885. PrimitiveThing subclass: #Incrementor
  2886.     instanceVariableNames: 'node '
  2887.     classVariableNames: 'DisplayForm '
  2888.     poolDictionaries: ''
  2889.     category: 'Things-Primitive'!
  2890.  
  2891.  
  2892. !Incrementor methodsFor: 'initialization'!
  2893.  
  2894. initializeConstraints
  2895.     "Incrementor initialize"
  2896.  
  2897.     self stronglyPreferEdit: #node.last.
  2898.     self methods: #('current _ last + 1')
  2899.         where: #((current node.value) (last node.last))
  2900.         strength: #strongPreferred.!
  2901.  
  2902. initializeStructure
  2903.  
  2904.     node _ Node cloneFor: self.!
  2905.  
  2906. initializeValues
  2907.  
  2908.     self set: #node.location.x to: 25.
  2909.     self set: #node.location.y to: 20.    
  2910.     self set: #node.last to: -1.! !
  2911.  
  2912. !Incrementor methodsFor: 'access'!
  2913.  
  2914. location
  2915.  
  2916.     ^node location!
  2917.  
  2918. node
  2919.  
  2920.     ^node! !
  2921.  
  2922. !Incrementor methodsFor: 'glyphs'!
  2923.  
  2924. boundingBox
  2925.     "Answer a box around my DisplayForm centered on my location."
  2926.  
  2927.     ^(self node location asPoint + DisplayForm offset)
  2928.         extent: (DisplayForm extent)!
  2929.  
  2930. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  2931.     "Display my display form at my location."
  2932.  
  2933.     DisplayForm
  2934.         displayOn: aDisplayMedium
  2935.         at: (aDisplayPoint + (node location asPoint))
  2936.         clippingBox: clipBox
  2937.         rule: (Form paint)
  2938.         mask: (Form black).!
  2939.  
  2940. glyphDependsOn
  2941.  
  2942.     ^Array with: node location!
  2943.  
  2944. selectableGlyphsInto: aSet
  2945.  
  2946.     aSet add: node.!
  2947.  
  2948. visibleGlyphsInto: aSet
  2949.  
  2950.     aSet add: node; add: self.! !
  2951. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2952.  
  2953. Incrementor class
  2954.     instanceVariableNames: ''!
  2955.  
  2956.  
  2957. !Incrementor class methodsFor: 'class initialization'!
  2958.  
  2959. initialize
  2960.     "Incrementor initialize"
  2961.  
  2962.     self initializePrimitive.
  2963.     partIcon _ (Form
  2964.         extent: 16@15
  2965.         fromArray: #(960 960 960 960 65535 32769 32769 34833 34833 48765 34833 34833 32769 32769 65535)
  2966.         offset: 0@0).
  2967.     DisplayForm _ (Form
  2968.         extent: 16@15
  2969.         fromArray: #(960 960 960 960 65535 32769 32769 34833 34833 48765 34833 34833 32769 32769 65535)
  2970.         offset: -8@-2).
  2971.     explainText _ 'A Incrementor is history constraint that makes the current value of its node greater by some increment each time history advances.'.! !
  2972.  
  2973. Incrementor initialize!
  2974.  
  2975. BasicTextThing subclass: #ParagraphThing
  2976.     instanceVariableNames: ''
  2977.     classVariableNames: ''
  2978.     poolDictionaries: ''
  2979.     category: 'Things-Primitive'!
  2980.  
  2981.  
  2982. !ParagraphThing methodsFor: 'initialization'!
  2983.  
  2984. initializeConstraints
  2985.     "ParagraphThing initialize"
  2986.  
  2987.     "layout constraints"
  2988.     self offset: #node.location.x by: -2 from: #box.topLeft.x.
  2989.     self offset: #node.location.y by: 0 from: #box.center.y.!
  2990.  
  2991. initializeStructure
  2992.  
  2993.     box _ CenterRectThing cloneFor: self.
  2994.     node _ Node cloneFor: self.!
  2995.  
  2996. initializeValues
  2997.  
  2998.     super initializeValues.
  2999.     self set: #box.topLeft.x to: 20.
  3000.     self set: #box.topLeft.y to: 20.    
  3001.     self set: #box.bottomRight.x to: 60.
  3002.     self set: #box.bottomRight.y to: 40.! !
  3003.  
  3004. !ParagraphThing methodsFor: 'glyphs'!
  3005.  
  3006. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  3007.     "Print my text as a Paragraph in my box."
  3008.  
  3009.     | textBox paragraph |
  3010.     textBox _ ((box asRectangle) insetOriginBy: 5@1 cornerBy: 4@1)
  3011.                 moveBy: aDisplayPoint.
  3012.     (textBox width < 10) ifTrue: [^self].        "too narrow to display text"
  3013.  
  3014.     paragraph _ Paragraph new.
  3015.     paragraph
  3016.         compositionRectangle: (0@0 extent: textBox extent);
  3017.         text: (self displayText asText).
  3018.     paragraph
  3019.         displayOn: aDisplayMedium
  3020.         at: (aDisplayPoint + textBox topLeft)
  3021.         clippingBox: (clipBox intersect: textBox).!
  3022.  
  3023. selectableGlyphsInto: aSet
  3024.  
  3025.     aSet
  3026.         add: box topLeft;
  3027.         add: box bottomRight;
  3028.         add: node;
  3029.         add: self.!
  3030.  
  3031. visibleGlyphsInto: aSet
  3032.  
  3033.     aSet add: box; add: node; add: self.! !
  3034. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3035.  
  3036. ParagraphThing class
  3037.     instanceVariableNames: ''!
  3038.  
  3039.  
  3040. !ParagraphThing class methodsFor: 'class initialization'!
  3041.  
  3042. initialize
  3043.     "ParagraphThing initialize"
  3044.  
  3045.     self initializePrimitive.
  3046.     partIcon _ (Form
  3047.         extent: 16@16
  3048.         fromArray: #( 0 16383 8193 11197 8193 11757 8193 61301 57345 11229 8193 11757 8193 8193 16383 0)
  3049.         offset: 0@0).
  3050.     explainText _ 'A ParagraphThing is a read-only viewer for text.'.! !
  3051.  
  3052. ParagraphThing initialize!
  3053.  
  3054. ParagraphThing subclass: #ParagraphThingMinusNodes
  3055.     instanceVariableNames: ''
  3056.     classVariableNames: ''
  3057.     poolDictionaries: ''
  3058.     category: 'Things-MinusNodes'!
  3059.  
  3060.  
  3061. !ParagraphThingMinusNodes methodsFor: 'glyphs'!
  3062.  
  3063. selectableGlyphsInto: aSet
  3064.  
  3065.     aSet
  3066.         add: box topLeft;
  3067.         add: box bottomRight;
  3068.         add: self.!
  3069.  
  3070. visibleGlyphsInto: aSet
  3071.  
  3072.     aSet add: box; add: self.! !
  3073. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3074.  
  3075. ParagraphThingMinusNodes class
  3076.     instanceVariableNames: ''!
  3077.  
  3078.  
  3079. !ParagraphThingMinusNodes class methodsFor: 'class initialization'!
  3080.  
  3081. initialize
  3082.     "ParagraphThingMinusNodes initialize"
  3083.  
  3084.     super initialize.
  3085.     explainText _ 'I am like a ParagraphThing except that my connection points are hidden.'.! !
  3086.  
  3087. ParagraphThingMinusNodes initialize!
  3088.  
  3089. BasicTextThing subclass: #TextThing
  3090.     instanceVariableNames: ''
  3091.     classVariableNames: ''
  3092.     poolDictionaries: ''
  3093.     category: 'Things-Primitive'!
  3094.  
  3095.  
  3096. !TextThing methodsFor: 'initialization'!
  3097.  
  3098. initializeConstraints
  3099.     "TextThing initialize"
  3100.  
  3101.     super initializeConstraints.
  3102.  
  3103.     self methods: #('width _ (QuickPrint width: text) + 4')
  3104.         where: #((width box.extent.x) (text node.value))
  3105.         strength: #strongPreferred.
  3106.  
  3107.     self methods: #('height _ (QuickPrint lineHeight) + 4')
  3108.         where: #((height box.extent.y))
  3109.         strength: #strongPreferred.! !
  3110.  
  3111. !TextThing methodsFor: 'glyphs'!
  3112.  
  3113. location
  3114.  
  3115.     ^box topLeft!
  3116.  
  3117. selectableGlyphsInto: aSet
  3118.  
  3119.     aSet add: self.!
  3120.  
  3121. visibleGlyphsInto: aSet
  3122.  
  3123.     aSet add: self.! !
  3124. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3125.  
  3126. TextThing class
  3127.     instanceVariableNames: ''!
  3128.  
  3129.  
  3130. !TextThing class methodsFor: 'class initialization'!
  3131.  
  3132. initialize
  3133.     "TextThing initialize"
  3134.  
  3135.     self initializePrimitive.
  3136.     partIcon _ (Form
  3137.         extent: 16@16
  3138.         fromArray: #(0 65535 0 0 4559 14633 27944 17864 32040 17705 17871 0 0 65535 0 0)
  3139.         offset: 0@0).
  3140.     explainText _ 'A TextThing is like a BasicTextThing except that its node and box outline are invisible. It is handy for adding labels to a Thing.'.! !
  3141.  
  3142. !TextThing class methodsFor: 'instance creation'!
  3143.  
  3144. newWith: aString
  3145.     "Answer a new instance of me initialized with the given string."
  3146.  
  3147.     ^(self new) set: #node.value to: aString! !
  3148.  
  3149. TextThing initialize!
  3150.  
  3151. PrimitiveThing subclass: #CustomConstraintThing
  3152.     instanceVariableNames: 'label strength '
  3153.     classVariableNames: ''
  3154.     poolDictionaries: ''
  3155.     category: 'Things-Private'!
  3156.  
  3157.  
  3158. !CustomConstraintThing methodsFor: 'initialization'!
  3159.  
  3160. initializeStructure
  3161.  
  3162.     label _ TextThing cloneFor: self.!
  3163.  
  3164. initializeValues
  3165.  
  3166.     self set: #label.node.value to: ' Custom '.
  3167.     self set: #label.box.center.x to: 40.
  3168.     self set: #label.box.center.y to: 50.
  3169.     self set: #label.box.fillRule to: Form under.
  3170.     strength _ #strongPreferred.! !
  3171.  
  3172. !CustomConstraintThing methodsFor: 'access'!
  3173.  
  3174. baseStrength
  3175.  
  3176.     ^strength!
  3177.  
  3178. baseStrength: strengthSymbol
  3179.  
  3180.     strength _ strengthSymbol.!
  3181.  
  3182. label
  3183.  
  3184.     ^label! !
  3185.  
  3186. !CustomConstraintThing methodsFor: 'glyphs'!
  3187.  
  3188. boundingBox
  3189.  
  3190.     ^label box asRectangle!
  3191.  
  3192. inputGlyphsInto: aSet
  3193.  
  3194.     super inputGlyphsInto: aSet.
  3195.     aSet add: self.!
  3196.  
  3197. visibleGlyphsInto: aSet
  3198.  
  3199.     super visibleGlyphsInto: aSet.
  3200.     aSet add: label box.! !
  3201.  
  3202. !CustomConstraintThing methodsFor: 'mouse'!
  3203.  
  3204. handleMouseDown: mousePoint view: aView
  3205.  
  3206.     ConstraintDefiner openOn: self view: aView.!
  3207.  
  3208. mouseConstraints
  3209.     "No mouse constraints."
  3210.  
  3211.     ^#()!
  3212.  
  3213. wantsMouse
  3214.  
  3215.     ^true! !
  3216. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3217.  
  3218. CustomConstraintThing class
  3219.     instanceVariableNames: ''!
  3220.  
  3221.  
  3222. !CustomConstraintThing class methodsFor: 'class initialization'!
  3223.  
  3224. initialize
  3225.     "CustomConstraintThing initialize"
  3226.  
  3227.     self initializePrimitive.
  3228.     partIcon _ (Form
  3229.         extent: 16@16
  3230.         fromArray: #(384 384 65535 32769 34689 35937 39105 38913 38913 39009 36033 34689 32769 65535 384 384)
  3231.         offset: 0@0).
  3232.     explainText _ 'A CustomConstaint allows the user to define his own constraint function over N variables.'.! !
  3233.  
  3234. CustomConstraintThing initialize!
  3235.  
  3236. PrimitiveThing subclass: #TreeNodeThing
  3237.     instanceVariableNames: 'text width '
  3238.     classVariableNames: ''
  3239.     poolDictionaries: ''
  3240.     category: 'Things-Primitive'!
  3241.  
  3242.  
  3243. !TreeNodeThing methodsFor: 'initialization'!
  3244.  
  3245. initializeStructure
  3246.  
  3247.     text _ TextThing cloneFor: self.!
  3248.  
  3249. initializeValues
  3250.  
  3251.     self set: #text.node.value to: 'ABC'.
  3252.     self set: #width to: 0.! !
  3253.  
  3254. !TreeNodeThing methodsFor: 'access'!
  3255.  
  3256. primwidth: aNumber
  3257.  
  3258.     width _ aNumber.!
  3259.  
  3260. text
  3261.  
  3262.     ^text!
  3263.  
  3264. width
  3265.  
  3266.     ^width! !
  3267. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3268.  
  3269. TreeNodeThing class
  3270.     instanceVariableNames: ''!
  3271.  
  3272.  
  3273. !TreeNodeThing class methodsFor: 'class initialization'!
  3274.  
  3275. initialize
  3276.     "TreeNodeThing initialize"
  3277.  
  3278.     self initializePrimitive.
  3279.     partIcon _ (Form
  3280.         extent: 16@16
  3281.         fromArray: #(0 65535 0 0 4559 14633 27944 17864 32040 17705 17871 0 0 65535 0 0)
  3282.         offset: 0@0).
  3283.     explainText _ 'A TreeNodeThing holds an editable string that may be used as a label in a tree.'.! !
  3284.  
  3285. TreeNodeThing initialize!
  3286.  
  3287. PrimitiveThing subclass: #ButtonThing
  3288.     instanceVariableNames: 'text node action '
  3289.     classVariableNames: ''
  3290.     poolDictionaries: ''
  3291.     category: 'Things-Primitive'!
  3292.  
  3293.  
  3294. !ButtonThing methodsFor: 'initialization'!
  3295.  
  3296. destroy
  3297.  
  3298.     "constraints do:
  3299.         [: c |
  3300.          c variables do: [: ref | ref destroy].
  3301.          c destroy]."
  3302.     action _ nil.
  3303.     super destroy.!
  3304.  
  3305. initializeConstraints
  3306.     "ButtonThing initialize"
  3307.  
  3308.     self methods: #(
  3309.             'color _ (value = 0) ifTrue: [Form white] ifFalse: [Form black]')
  3310.         where: #((color text.box.fillMask) (value node.value))
  3311.         strength: #strongPreferred.
  3312.  
  3313.     "layout"
  3314.     self offset: #text.box.center.x by: 0 from: #node.location.x.
  3315.     self offset: #node.location.y by: 4 from: #text.box.bottomRight.y.!
  3316.  
  3317. initializeStructure
  3318.  
  3319.     text _ TextThing cloneFor: self.
  3320.     node _ Node cloneFor: self.!
  3321.  
  3322. initializeValues
  3323.  
  3324.     self set: #text.node.value to: ' Button '.
  3325.     self set: #text.box.fillRule to: Form reverse.
  3326.     self set: #node.value to: 0.
  3327.     self set: #node.last to: 0.
  3328.     self set: #node.location.x to: 35.
  3329.     self set: #node.location.y to: 35.
  3330.     action _ nil.! !
  3331.  
  3332. !ButtonThing methodsFor: 'access'!
  3333.  
  3334. action
  3335.  
  3336.     ^action!
  3337.  
  3338. location
  3339.  
  3340.     ^text box topLeft!
  3341.  
  3342. node
  3343.  
  3344.     ^node!
  3345.  
  3346. primaction: aBlock
  3347.     "Set the action for this button, a block that takes the enclosing view as its argument."
  3348.  
  3349.     action _ aBlock.!
  3350.  
  3351. text
  3352.  
  3353.     ^text! !
  3354.  
  3355. !ButtonThing methodsFor: 'glyphs'!
  3356.  
  3357. boundingBox
  3358.  
  3359.     ^text boundingBox!
  3360.  
  3361. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  3362.  
  3363.     text displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox.
  3364.     text box displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox.!
  3365.  
  3366. glyphDependsOn
  3367.  
  3368.     ^(Array
  3369.         with: text box topLeft
  3370.         with: text box bottomRight
  3371.         with: text node    "button label text"
  3372.         with: node)        "button value"!
  3373.  
  3374. inputGlyphsInto: aSet
  3375.  
  3376.     aSet add: text; add: self.!
  3377.  
  3378. selectableGlyphsInto: aSet
  3379.  
  3380.     aSet add: text; add: node.!
  3381.  
  3382. visibleGlyphsInto: aSet
  3383.  
  3384.     aSet add: node; add: self.! !
  3385.  
  3386. !ButtonThing methodsFor: 'mouse'!
  3387.  
  3388. handleMouseDown: mousePoint view: aView
  3389.  
  3390.     node primvalue: 1.!
  3391.  
  3392. handleMouseUp: mousePoint view: aView
  3393.  
  3394.     ((self containsPoint: mousePoint) and: [action notNil]) ifTrue:
  3395.         [action value: aView].
  3396.     node primvalue: 0.!
  3397.  
  3398. mouseConstraints
  3399.     "No mouse constraints."
  3400.  
  3401.     ^Array
  3402.         with: (EditConstraint
  3403.                 ref:     self->#node.value
  3404.                 strength: ThingLabII editStrength)!
  3405.  
  3406. wantsMouse
  3407.  
  3408.     ^true! !
  3409. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3410.  
  3411. ButtonThing class
  3412.     instanceVariableNames: ''!
  3413.  
  3414.  
  3415. !ButtonThing class methodsFor: 'class initialization'!
  3416.  
  3417. initialize
  3418.     "ButtonThing initialize"
  3419.  
  3420.     self initializePrimitive.
  3421.     partIcon _ (Form
  3422.         extent: 16@16
  3423.         fromArray: #(0 128 128 128 672 448 128 4095 4097 8195 16389 32761 16401 16402 16404 32760)
  3424.         offset: 0@0).
  3425.     explainText _ 'A ButtonThing consists of a label and a Node. The Node value is 1 while the button is depressed, 0 otherwise.'.! !
  3426.  
  3427. ButtonThing initialize!
  3428.  
  3429. CustomConstraintThing subclass: #CustomTwo
  3430.     instanceVariableNames: 'wire1 wire2 '
  3431.     classVariableNames: ''
  3432.     poolDictionaries: ''
  3433.     category: 'Things-Primitive'!
  3434.  
  3435.  
  3436. !CustomTwo methodsFor: 'initialization'!
  3437.  
  3438. initializeConstraints
  3439.     "CustomTwo initialize"
  3440.  
  3441.     "layout constraints"
  3442.     super initializeConstraints.
  3443.     self offset: #wire1.node1.location.x by: 0 from: #label.box.center.x.
  3444.     self offset: #wire1.node1.location.y by: -2 from: #label.box.topLeft.y.
  3445.     self offset: #wire2.node1.location.x by: 0 from: #label.box.center.x.
  3446.     self offset: #wire2.node1.location.y by: 2 from: #label.box.bottomRight.y.!
  3447.  
  3448. initializeStructure
  3449.  
  3450.     super initializeStructure.
  3451.     wire1 _ WireThing cloneFor: self.
  3452.     wire2 _ WireThing cloneFor: self.!
  3453.  
  3454. initializeValues
  3455.  
  3456.     super initializeValues.
  3457.     self set: #wire1.node2.location.x to: (wire1 node1 location x).
  3458.     self set: #wire1.node2.location.y to: 10.
  3459.     self set: #wire2.node2.location.x to:  (wire2 node1 location x).
  3460.     self set: #wire2.node2.location.y to: 90.! !
  3461.  
  3462. !CustomTwo methodsFor: 'access'!
  3463.  
  3464. wire1
  3465.  
  3466.     ^wire1!
  3467.  
  3468. wire2
  3469.  
  3470.     ^wire2! !
  3471.  
  3472. !CustomTwo methodsFor: 'custom constraint'!
  3473.  
  3474. baseConstraint
  3475.  
  3476.     ^self constraints
  3477.         detect: [: c | c isMemberOf: Constraint]
  3478.         ifNone:
  3479.             [Constraint
  3480.                 symbols: #(a b)
  3481.                 methodStrings: #()
  3482.                 refs: (Array
  3483.                     with: self->#wire1.node1.value
  3484.                     with: self->#wire2.node1.value)
  3485.                 strength: strength]!
  3486.  
  3487. baseConstraint: newConstraint
  3488.  
  3489.     | oldConstraint |
  3490.     oldConstraint _ self constraints
  3491.         detect: [: c | c isMemberOf: Constraint]
  3492.         ifNone: [nil].
  3493.     (oldConstraint notNil) ifTrue:
  3494.         [self removeConstraint: oldConstraint.
  3495.          oldConstraint destroy].
  3496.     (newConstraint notNil) ifTrue:
  3497.         [newConstraint
  3498.             bind: (Array
  3499.                 with: self->#wire1.node1.value
  3500.                 with: self->#wire2.node1.value)
  3501.              strength: strength.
  3502.          self addConstraint: newConstraint].! !
  3503. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3504.  
  3505. CustomTwo class
  3506.     instanceVariableNames: ''!
  3507.  
  3508.  
  3509. !CustomTwo class methodsFor: 'class initialization'!
  3510.  
  3511. initialize
  3512.     "CustomTwo initialize"
  3513.  
  3514.     super initialize.! !
  3515.  
  3516. CustomTwo initialize!
  3517.  
  3518. CustomConstraintThing subclass: #CustomFour
  3519.     instanceVariableNames: 'wire1 wire2 wire3 wire4 '
  3520.     classVariableNames: ''
  3521.     poolDictionaries: ''
  3522.     category: 'Things-Primitive'!
  3523.  
  3524.  
  3525. !CustomFour methodsFor: 'initialization'!
  3526.  
  3527. initializeConstraints
  3528.     "CustomFour initialize"
  3529.  
  3530.     "layout constraints"
  3531.     super initializeConstraints.
  3532.     self offset: #wire1.node1.location.x by: -4 from: #label.box.center.x.
  3533.     self offset: #wire1.node1.location.y by: -2 from: #label.box.topLeft.y.
  3534.     self offset: #wire2.node1.location.x by: 4 from: #label.box.center.x.
  3535.     self offset: #wire2.node1.location.y by: -2 from: #label.box.topLeft.y.
  3536.     self offset: #wire3.node1.location.x by: -4 from: #label.box.center.x.
  3537.     self offset: #wire3.node1.location.y by: 2 from: #label.box.bottomRight.y.
  3538.     self offset: #wire4.node1.location.x by: 4 from: #label.box.center.x.
  3539.     self offset: #wire4.node1.location.y by: 2 from: #label.box.bottomRight.y.!
  3540.  
  3541. initializeStructure
  3542.  
  3543.     super initializeStructure.
  3544.     wire1 _ WireThing cloneFor: self.
  3545.     wire2 _ WireThing cloneFor: self.
  3546.     wire3 _ WireThing cloneFor: self.
  3547.     wire4 _ WireThing cloneFor: self.!
  3548.  
  3549. initializeValues
  3550.  
  3551.     super initializeValues.
  3552.     self set: #wire1.node2.location.x to: (wire1 node1 location x).
  3553.     self set: #wire1.node2.location.y to: 10.
  3554.     self set: #wire2.node2.location.x to: (wire2 node1 location x).
  3555.     self set: #wire2.node2.location.y to: 10.
  3556.     self set: #wire3.node2.location.x to: (wire3 node1 location x).
  3557.     self set: #wire3.node2.location.y to: 90.
  3558.     self set: #wire4.node2.location.x to: (wire4 node1 location x).
  3559.     self set: #wire4.node2.location.y to: 90.! !
  3560.  
  3561. !CustomFour methodsFor: 'access'!
  3562.  
  3563. wire1
  3564.  
  3565.     ^wire1!
  3566.  
  3567. wire2
  3568.  
  3569.     ^wire2!
  3570.  
  3571. wire3
  3572.  
  3573.     ^wire3!
  3574.  
  3575. wire4
  3576.  
  3577.     ^wire4! !
  3578.  
  3579. !CustomFour methodsFor: 'custom constraint'!
  3580.  
  3581. baseConstraint
  3582.  
  3583.     ^self constraints
  3584.         detect: [: c | c isMemberOf: Constraint]
  3585.         ifNone:
  3586.             [Constraint
  3587.                 symbols: #(a b c d)
  3588.                 methodStrings: #()
  3589.                 refs: (Array
  3590.                     with: self->#wire1.node1.value
  3591.                     with: self->#wire2.node1.value
  3592.                     with: self->#wire3.node1.value
  3593.                     with: self->#wire4.node1.value)
  3594.                 strength: strength]!
  3595.  
  3596. baseConstraint: newConstraint
  3597.  
  3598.     | oldConstraint |
  3599.     oldConstraint _ self constraints
  3600.         detect: [: c | c isMemberOf: Constraint]
  3601.         ifNone: [nil].
  3602.     (oldConstraint notNil) ifTrue:
  3603.         [self removeConstraint: oldConstraint.
  3604.          oldConstraint destroy].
  3605.     (newConstraint notNil) ifTrue:
  3606.         [newConstraint
  3607.             bind: (Array
  3608.                 with: self->#wire1.node1.value
  3609.                 with: self->#wire2.node1.value
  3610.                 with: self->#wire3.node1.value
  3611.                 with: self->#wire4.node1.value)
  3612.             strength: strength.
  3613.          self addConstraint: newConstraint].! !
  3614. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3615.  
  3616. CustomFour class
  3617.     instanceVariableNames: ''!
  3618.  
  3619.  
  3620. !CustomFour class methodsFor: 'class initialization'!
  3621.  
  3622. initialize
  3623.     "CustomFour initialize"
  3624.  
  3625.     super initialize.! !
  3626.  
  3627. CustomFour initialize!
  3628.  
  3629. ButtonThing subclass: #ButtonThingMinusNodes
  3630.     instanceVariableNames: ''
  3631.     classVariableNames: ''
  3632.     poolDictionaries: ''
  3633.     category: 'Things-MinusNodes'!
  3634.  
  3635.  
  3636. !ButtonThingMinusNodes methodsFor: 'glyphs'!
  3637.  
  3638. selectableGlyphsInto: aSet
  3639.  
  3640.     aSet add: text.!
  3641.  
  3642. visibleGlyphsInto: aSet
  3643.  
  3644.     aSet add: self.! !
  3645. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3646.  
  3647. ButtonThingMinusNodes class
  3648.     instanceVariableNames: ''!
  3649.  
  3650.  
  3651. !ButtonThingMinusNodes class methodsFor: 'class initialization'!
  3652.  
  3653. initialize
  3654.     "ButtonThingMinusNodes initialize"
  3655.  
  3656.     super initialize.
  3657.     explainText _ 'I am like a ButtonThing except that my connection point is hidden.'.! !
  3658.  
  3659. ButtonThingMinusNodes initialize!
  3660.  
  3661. CustomConstraintThing subclass: #CustomThree
  3662.     instanceVariableNames: 'wire1 wire2 wire3 '
  3663.     classVariableNames: ''
  3664.     poolDictionaries: ''
  3665.     category: 'Things-Primitive'!
  3666.  
  3667.  
  3668. !CustomThree methodsFor: 'initialization'!
  3669.  
  3670. initializeConstraints
  3671.     "CustomThree initialize"
  3672.  
  3673.     "layout constraints"
  3674.     super initializeConstraints.
  3675.     self offset: #wire1.node1.location.x by: -4 from: #label.box.center.x.
  3676.     self offset: #wire1.node1.location.y by: -2 from: #label.box.topLeft.y.
  3677.     self offset: #wire2.node1.location.x by: 4 from: #label.box.center.x.
  3678.     self offset: #wire2.node1.location.y by: -2 from: #label.box.topLeft.y.
  3679.     self offset: #wire3.node1.location.x by: 0 from: #label.box.center.x.
  3680.     self offset: #wire3.node1.location.y by: 2 from: #label.box.bottomRight.y.!
  3681.  
  3682. initializeStructure
  3683.  
  3684.     super initializeStructure.
  3685.     wire1 _ WireThing cloneFor: self.
  3686.     wire2 _ WireThing cloneFor: self.
  3687.     wire3 _ WireThing cloneFor: self.!
  3688.  
  3689. initializeValues
  3690.  
  3691.     super initializeValues.
  3692.     self set: #wire1.node2.location.x to: (wire1 node1 location x).
  3693.     self set: #wire1.node2.location.y to: 10.
  3694.     self set: #wire2.node2.location.x to: (wire2 node1 location x).
  3695.     self set: #wire2.node2.location.y to: 10.
  3696.     self set: #wire3.node2.location.x to: (wire3 node1 location x).
  3697.     self set: #wire3.node2.location.y to: 90.! !
  3698.  
  3699. !CustomThree methodsFor: 'access'!
  3700.  
  3701. wire1
  3702.  
  3703.     ^wire1!
  3704.  
  3705. wire2
  3706.  
  3707.     ^wire2!
  3708.  
  3709. wire3
  3710.  
  3711.     ^wire3! !
  3712.  
  3713. !CustomThree methodsFor: 'custom constraint'!
  3714.  
  3715. baseConstraint
  3716.  
  3717.     ^self constraints
  3718.         detect: [: c | c isMemberOf: Constraint]
  3719.         ifNone:
  3720.             [Constraint
  3721.                 symbols: #(a b c)
  3722.                 methodStrings: #()
  3723.                 refs: (Array
  3724.                     with: self->#wire1.node1.value
  3725.                     with: self->#wire2.node1.value
  3726.                     with: self->#wire3.node1.value)
  3727.                 strength: strength]!
  3728.  
  3729. baseConstraint: newConstraint
  3730.  
  3731.     | oldConstraint |
  3732.     oldConstraint _ self constraints
  3733.         detect: [: c | c isMemberOf: Constraint]
  3734.         ifNone: [nil].
  3735.     (oldConstraint notNil) ifTrue:
  3736.         [self removeConstraint: oldConstraint.
  3737.          oldConstraint destroy].
  3738.     (newConstraint notNil) ifTrue:
  3739.         [newConstraint
  3740.             bind: (Array
  3741.                 with: self->#wire1.node1.value
  3742.                 with: self->#wire2.node1.value
  3743.                 with: self->#wire3.node1.value)
  3744.              strength: strength.
  3745.          self addConstraint: newConstraint].! !
  3746. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3747.  
  3748. CustomThree class
  3749.     instanceVariableNames: ''!
  3750.  
  3751.  
  3752. !CustomThree class methodsFor: 'class initialization'!
  3753.  
  3754. initialize
  3755.     "CustomThree initialize"
  3756.  
  3757.     super initialize.! !
  3758.  
  3759. CustomThree initialize!
  3760.  
  3761. PrimitiveThing subclass: #Product
  3762.     instanceVariableNames: 'op '
  3763.     classVariableNames: ''
  3764.     poolDictionaries: ''
  3765.     category: 'Things-Primitive'!
  3766.  
  3767.  
  3768. !Product methodsFor: 'initialization'!
  3769.  
  3770. initializeConstraints
  3771.     "Product initialize"
  3772.  
  3773.     self methods: #(
  3774.             'prod _ m1 asFloat * m2'
  3775.             'm1 _ prod asFloat / m2 asFloat asNonZero'
  3776.             'm2 _ prod asFloat / m1 asFloat asNonZero')
  3777.         where: #((prod op.c.value) (m1 op.a.value) (m2 op.b.value))
  3778.         strength: #required.!
  3779.  
  3780. initializeStructure
  3781.  
  3782.     op _ ThreeWayOp cloneFor: self.!
  3783.  
  3784. initializeValues
  3785.  
  3786.     self set: #op.a.value to: 0.
  3787.     self set: #op.b.value to: 0.
  3788.     self set: #op.c.value to: 0.
  3789.     self set: #op.opForm to:
  3790.         (Form
  3791.             extent: 9@11
  3792.             fromArray: #(15872 16640 32896 46720 40064 34944 40064 46720 32896 16640 15872)
  3793.             offset: -4@-5).! !
  3794.  
  3795. !Product methodsFor: 'access'!
  3796.  
  3797. op
  3798.  
  3799.     ^op! !
  3800. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3801.  
  3802. Product class
  3803.     instanceVariableNames: ''!
  3804.  
  3805.  
  3806. !Product class methodsFor: 'class initialization'!
  3807.  
  3808. initialize
  3809.     "Product initialize"
  3810.  
  3811.     self initializePrimitive.
  3812.     partIcon _ Form
  3813.         extent: 16@16
  3814.         fromArray: #(8184 16380 28686 57351 49155 50211 49731 49539 49539 49731 50211 49155 57351 28686 16380 8184)
  3815.         offset: 0@0.
  3816.     explainText _ 'A Product is a three operand arithmetic constraint, x * y = z'.! !
  3817.  
  3818. Product initialize!
  3819.  
  3820. PrimitiveThing subclass: #TwoWayOp
  3821.     instanceVariableNames: 'location opForm a b '
  3822.     classVariableNames: ''
  3823.     poolDictionaries: ''
  3824.     category: 'Things-Private'!
  3825.  
  3826.  
  3827. !TwoWayOp methodsFor: 'initialization'!
  3828.  
  3829. initializeStructure
  3830.  
  3831.     a _ Node cloneFor: self.
  3832.     b _ Node cloneFor: self.
  3833.     location _ PointThing cloneFor: self.!
  3834.  
  3835. initializeValues
  3836.  
  3837.     self set: #a.location.x to: 20.
  3838.     self set: #a.location.y to: 30.
  3839.     self set: #b.location.x to: 80.
  3840.     self set: #b.location.y to: 30.
  3841.     self set: #location.x to: 50.
  3842.     self set: #location.y to: 30.
  3843.     self set: #opForm to:
  3844.         (Form
  3845.             extent: 9@9
  3846.             fromArray: #(65408 32896 40064 41600 33920 34944 32896 34944 65408)
  3847.             offset: -4@-4).! !
  3848.  
  3849. !TwoWayOp methodsFor: 'glyphs'!
  3850.  
  3851. boundingBox
  3852.     "Answer a box around my opForm centered on my location."
  3853.  
  3854.     ^(location asPoint + opForm offset)
  3855.         extent: (opForm extent)!
  3856.  
  3857. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  3858.  
  3859.     | line |
  3860.     line _ Line
  3861.         from: (location asPoint)
  3862.         to: 0@0    "filled in below"
  3863.         withForm: (Form extent: 1@1) black.
  3864.     (Array with: a with: b) do:
  3865.         [: part |
  3866.          line endPoint: part location asPoint.
  3867.          line
  3868.             displayOn: aDisplayMedium
  3869.             at: aDisplayPoint
  3870.             clippingBox: clipBox
  3871.             rule: (Form paint)
  3872.             mask: (Form black)].
  3873.     opForm
  3874.         displayOn: aDisplayMedium
  3875.         at: (aDisplayPoint + location asPoint)
  3876.         clippingBox: clipBox
  3877.         rule: (Form over)
  3878.         mask: (Form black).!
  3879.  
  3880. glyphDependsOn
  3881.  
  3882.     ^Array
  3883.         with: self location
  3884.         with: a location
  3885.         with: b location!
  3886.  
  3887. selectableGlyphsInto: aSet
  3888.  
  3889.     a visibleGlyphsInto: aSet.
  3890.     b visibleGlyphsInto: aSet.
  3891.     aSet add: self.!
  3892.  
  3893. visibleGlyphsInto: aSet
  3894.  
  3895.     a visibleGlyphsInto: aSet.
  3896.     b visibleGlyphsInto: aSet.
  3897.     aSet add: self.! !
  3898.  
  3899. !TwoWayOp methodsFor: 'access'!
  3900.  
  3901. a
  3902.  
  3903.     ^a!
  3904.  
  3905. b
  3906.  
  3907.     ^b!
  3908.  
  3909. location
  3910.  
  3911.     ^location!
  3912.  
  3913. opForm
  3914.  
  3915.     ^opForm!
  3916.  
  3917. primopForm: aForm
  3918.  
  3919.     opForm _ aForm.! !
  3920. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3921.  
  3922. TwoWayOp class
  3923.     instanceVariableNames: ''!
  3924.  
  3925.  
  3926. !TwoWayOp class methodsFor: 'class initialization'!
  3927.  
  3928. initialize
  3929.     "TwoWayOp initialize"
  3930.  
  3931.     self initializePrimitive.
  3932.     partIcon _ (Form
  3933.         extent: 16@16
  3934.         fromArray: #(8184 16380 28686 59367 53235 52275 52787 50787 49347 49539 49155 49539 57735 28686 16380 8184)
  3935.         offset: 0@0).
  3936.     explainText _ 'A TwoWayOp is a template for two operand operators. It is used as a sub-part of other Things, rather than as a stand-alone Thing. It provides two Nodes and an operator Form.'.! !
  3937.  
  3938. TwoWayOp initialize!
  3939.  
  3940. PrimitiveThing subclass: #Invert
  3941.     instanceVariableNames: 'op '
  3942.     classVariableNames: ''
  3943.     poolDictionaries: ''
  3944.     category: 'Things-Primitive'!
  3945. Invert comment:
  3946. 'This Thing is a copy of Sum as of 18-Jan-89 modified to handle Forms.  This Thing inverts the bitmap as it goes through.'!
  3947.  
  3948.  
  3949. !Invert methodsFor: 'initialization'!
  3950.  
  3951. initializeConstraints
  3952.     "Invert initialize"
  3953.  
  3954.     self methods: #(
  3955.             'a _ b deepCopy reverse'
  3956.             'b _ a deepCopy reverse')
  3957.         where: #((a op.a.value) (b op.b.value))
  3958.         strength: #strongPreferred.!
  3959.  
  3960. initializeStructure
  3961.  
  3962.     op _ TwoWayOp cloneFor: self.!
  3963.  
  3964. initializeValues
  3965.  
  3966.     self set: #op.a.value to: (Form extent: 30@20).
  3967.     self set: #op.b.value to: (Form extent: 30@20).
  3968.     self set: #op.opForm to:
  3969.         (Form
  3970.             extent: 9@9
  3971.             fromArray: #(32512 65408 60288 60288 48768 56704 58240 65408 32512 )
  3972.             offset: -4@-4).! !
  3973.  
  3974. !Invert methodsFor: 'access'!
  3975.  
  3976. op
  3977.  
  3978.     ^op! !
  3979. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3980.  
  3981. Invert class
  3982.     instanceVariableNames: ''!
  3983.  
  3984.  
  3985. !Invert class methodsFor: 'class initialization'!
  3986.  
  3987. initialize
  3988.     "Invert initialize"
  3989.  
  3990.     self initializePrimitive.
  3991.     partIcon _ Form
  3992.         extent: 16@16
  3993.         fromArray: #(8184 16380 32766 65535 63903 63903 65535 65535 65535 59367 58311 61455 63519 32766 16380 8184)
  3994.         offset: 0@0.
  3995.     explainText _ 'An Invert is a two operand Form constraint, a = invert(b)'.! !
  3996.  
  3997. Invert initialize!
  3998.  
  3999. PrimitiveThing subclass: #PointSplitter
  4000.     instanceVariableNames: 'op point '
  4001.     classVariableNames: ''
  4002.     poolDictionaries: ''
  4003.     category: 'Things-Primitive'!
  4004.  
  4005.  
  4006. !PointSplitter methodsFor: 'initialization'!
  4007.  
  4008. initializeConstraints
  4009.     "PointSplitter initialize"
  4010.  
  4011.     self require: #op.a.value equals: #point.x.
  4012.     self require: #op.b.value equals: #point.y.
  4013.  
  4014.     "layout constraints"
  4015.     self offset: #op.a.location.x by: -5 from: #op.location.x.
  4016.     self offset: #op.a.location.y by: -7 from: #op.location.y.
  4017.     self offset: #op.b.location.x by: 6 from: #op.location.x.
  4018.     self offset: #op.b.location.y by: -7 from: #op.location.y.!
  4019.  
  4020. initializeStructure
  4021.  
  4022.     op _ TwoWayOp cloneFor: self.
  4023.     point _ PointThing cloneFor: self.!
  4024.  
  4025. initializeValues
  4026.  
  4027.     self set: #op.a.value to: 30.
  4028.     self set: #op.b.value to: 30.
  4029.     self set: #op.opForm to:
  4030.         (Form
  4031.             extent: 21@9
  4032.             fromArray: #(65535 63488 32800 2048 37156 18432 35364 18432 33827 34816 35361 2048 37153 2048 32800 2048 65535 63488)
  4033.             offset: -10@-5).! !
  4034.  
  4035. !PointSplitter methodsFor: 'access'!
  4036.  
  4037. op
  4038.  
  4039.     ^op!
  4040.  
  4041. point
  4042.  
  4043.     ^point! !
  4044. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4045.  
  4046. PointSplitter class
  4047.     instanceVariableNames: ''!
  4048.  
  4049.  
  4050. !PointSplitter class methodsFor: 'class initialization'!
  4051.  
  4052. initialize
  4053.     "PointSplitter initialize"
  4054.  
  4055.     self initializePrimitive.
  4056.     partIcon _ (Form
  4057.         extent: 16@16
  4058.         fromArray: #(0 0 0 0 14392 14392 65535 33025 42309 39225 39185 42257 33025 65535 0 0)
  4059.         offset: 0@0).
  4060.     explainText _ 'A PointSplitter relates a point to separate nodes for its x and y parts. This allows one to perform arithmetic on points.'.! !
  4061.  
  4062. PointSplitter initialize!
  4063.  
  4064. PrimitiveThing subclass: #FatBits
  4065.     instanceVariableNames: 'op '
  4066.     classVariableNames: ''
  4067.     poolDictionaries: ''
  4068.     category: 'Things-Primitive'!
  4069.  
  4070.  
  4071. !FatBits methodsFor: 'initialization'!
  4072.  
  4073. initializeConstraints
  4074.     "FatBits initialize"
  4075.  
  4076.     self methods: #(
  4077.             'a _ b shrinkBy: 2@2'
  4078.             'b _ a magnifyBy: 2@2')
  4079.         where: #((a op.a.value) (b op.b.value))
  4080.         strength: #strongPreferred.!
  4081.  
  4082. initializeStructure
  4083.  
  4084.     op _ TwoWayOp cloneFor: self.!
  4085.  
  4086. initializeValues
  4087.  
  4088.     self set: #op.a.value to: (Form extent: 30@20).
  4089.     self set: #op.b.value to: (Form extent: 30@20).
  4090.     self set: #op.opForm to:
  4091.         (Form
  4092.             extent: 9@9
  4093.             fromArray: #(32512 49536 46720 46720 32896 48768 48768 49536 32512)
  4094.             offset: -4@-4).! !
  4095.  
  4096. !FatBits methodsFor: 'access'!
  4097.  
  4098. op
  4099.  
  4100.     ^op! !
  4101. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4102.  
  4103. FatBits class
  4104.     instanceVariableNames: ''!
  4105.  
  4106.  
  4107. !FatBits class methodsFor: 'class initialization'!
  4108.  
  4109. initialize
  4110.     "FatBits initialize"
  4111.  
  4112.     self initializePrimitive.
  4113.     partIcon _ (Form
  4114.         extent: 16@16
  4115.         fromArray: #(8184 16380 28686 58983 52851 52851 52851 49155 55323 56379 57339 53235 59367 28686 16380 8184)
  4116.         offset: 0@0).
  4117.     explainText _ 'A FatBits is a two operand graphic Thing.  One Form is constrainted to be twice the size of the other.'.! !
  4118.  
  4119. FatBits initialize!
  4120.  
  4121. PrimitiveThing subclass: #VerticalFlip
  4122.     instanceVariableNames: 'op '
  4123.     classVariableNames: ''
  4124.     poolDictionaries: ''
  4125.     category: 'Things-Primitive'!
  4126.  
  4127.  
  4128. !VerticalFlip methodsFor: 'initialization'!
  4129.  
  4130. initializeConstraints
  4131.     "VerticalFlip initialize"
  4132.  
  4133.     self methods: #(
  4134.             'a _ b reflect: 0@1'
  4135.             'b _ a reflect: 0@1')
  4136.         where: #((a op.a.value) (b op.b.value))
  4137.         strength: #strongPreferred.!
  4138.  
  4139. initializeStructure
  4140.  
  4141.     op _ TwoWayOp cloneFor: self.!
  4142.  
  4143. initializeValues
  4144.  
  4145.     self set: #op.a.value to: (Form extent: 30@20).
  4146.     self set: #op.b.value to: (Form extent: 30@20).
  4147.     self set: #op.opForm to:
  4148.         (Form
  4149.             extent: 9@9
  4150.             fromArray: #(32512 49536 40064 41600 32896 38016 32896 49536 32512)
  4151.             offset: -4@-4).! !
  4152.  
  4153. !VerticalFlip methodsFor: 'access'!
  4154.  
  4155. op
  4156.  
  4157.     ^op! !
  4158. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4159.  
  4160. VerticalFlip class
  4161.     instanceVariableNames: ''!
  4162.  
  4163.  
  4164. !VerticalFlip class methodsFor: 'class initialization'!
  4165.  
  4166. initialize
  4167.     "VerticalFlip initialize"
  4168.  
  4169.     self initializePrimitive.
  4170.     partIcon _ (Form
  4171.         extent: 16@16
  4172.         fromArray: #(8184 16380 28686 57351 51171 53235 52275 49155 49155 50787 50787 50787 57351 28686 16380 8184)
  4173.         offset: 0@0).
  4174.     explainText _ 'VerticalFlip flips a Form about the X axis, i.e. it turns things upside down.'.! !
  4175.  
  4176. VerticalFlip initialize!
  4177.  
  4178. Node subclass: #NodeMinusNodes
  4179.     instanceVariableNames: ''
  4180.     classVariableNames: ''
  4181.     poolDictionaries: ''
  4182.     category: 'Things-MinusNodes'!
  4183.  
  4184.  
  4185. !NodeMinusNodes methodsFor: 'glyphs'!
  4186.  
  4187. selectableGlyphsInto: aSet!
  4188.  
  4189. visibleGlyphsInto: aSet! !
  4190. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4191.  
  4192. NodeMinusNodes class
  4193.     instanceVariableNames: ''!
  4194.  
  4195.  
  4196. !NodeMinusNodes class methodsFor: 'class initialization'!
  4197.  
  4198. initialize
  4199.     "NodeMinusNodes initialize"
  4200.  
  4201.     super initialize.
  4202.     explainText _ 'I am an invisible Node.'.! !
  4203.  
  4204. NodeMinusNodes initialize!
  4205.  
  4206. VSliderThing subclass: #VSliderThingMinusNodes
  4207.     instanceVariableNames: ''
  4208.     classVariableNames: ''
  4209.     poolDictionaries: ''
  4210.     category: 'Things-MinusNodes'!
  4211.  
  4212.  
  4213. !VSliderThingMinusNodes methodsFor: 'glyphs'!
  4214.  
  4215. selectableGlyphsInto: aSet!
  4216.  
  4217. visibleGlyphsInto: aSet
  4218.  
  4219.     aSet add: box; add: self.! !
  4220. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4221.  
  4222. VSliderThingMinusNodes class
  4223.     instanceVariableNames: ''!
  4224.  
  4225.  
  4226. !VSliderThingMinusNodes class methodsFor: 'class initialization'!
  4227.  
  4228. initialize
  4229.     "VSliderThingMinusNodes initialize"
  4230.  
  4231.     super initialize.
  4232.     explainText _ 'I am like a VSliderThing except that my connection points are hidden.'.! !
  4233.  
  4234. VSliderThingMinusNodes initialize!
  4235.  
  4236. PrimitiveThing subclass: #NoteThing
  4237.     instanceVariableNames: 'time pitch type location stemDirection '
  4238.     classVariableNames: ''
  4239.     poolDictionaries: ''
  4240.     category: 'Things-Primitive'!
  4241.  
  4242.  
  4243. !NoteThing methodsFor: 'initialization'!
  4244.  
  4245. initializeStructure
  4246.  
  4247.     location _ PointThing cloneFor: self.!
  4248.  
  4249. initializeValues
  4250.  
  4251.     self set: #location.x to: 20.
  4252.     self set: #location.y to: 40.
  4253.     self set: #time to: 0.
  4254.     self set: #pitch to: 60.        "middle c"
  4255.     self set: #type to: 3.        "quarter note"
  4256.     self set: #stemDirection to: #up.! !
  4257.  
  4258. !NoteThing methodsFor: 'access'!
  4259.  
  4260. duration
  4261.     "Duration is a read-only virtual part."
  4262.  
  4263.     (type == 1) ifTrue: [^15].        "sixteenth"
  4264.     (type == 2) ifTrue: [^30].        "eighth"
  4265.     (type == 3) ifTrue: [^60].        "quarter"
  4266.     (type == 4) ifTrue: [^120].        "half"
  4267.     (type == 5) ifTrue: [^240].        "whole"
  4268.     ^60        "default: pretend I am a quarter note"!
  4269.  
  4270. location
  4271.  
  4272.     ^location!
  4273.  
  4274. pitch
  4275.  
  4276.     ^pitch!
  4277.  
  4278. primpitch: aNumber
  4279.  
  4280.     pitch _ aNumber.!
  4281.  
  4282. primstemDirection: aSymbol
  4283.     "#up or #down"
  4284.  
  4285.     stemDirection _ aSymbol.!
  4286.  
  4287. primtime: aNumber
  4288.  
  4289.     time _ aNumber.!
  4290.  
  4291. primtype: aNumber
  4292.  
  4293.     type _ aNumber.!
  4294.  
  4295. stemDirection
  4296.     "#up or #down"
  4297.  
  4298.     ^stemDirection!
  4299.  
  4300. time
  4301.  
  4302.     ^time!
  4303.  
  4304. type
  4305.  
  4306.     ^type! !
  4307.  
  4308. !NoteThing methodsFor: 'glyphs'!
  4309.  
  4310. boundingBox
  4311.  
  4312.     ^(self form computeBoundingBox)
  4313.         translateBy: self form offset + location asPoint!
  4314.  
  4315. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipBox
  4316.  
  4317.     self form
  4318.         displayOn: aDisplayMedium
  4319.         at: aDisplayPoint + location asPoint    
  4320.         clippingBox: clipBox
  4321.         rule: Form paint
  4322.         mask: Form black.!
  4323.  
  4324. downForm
  4325.  
  4326.     (type == 1) ifTrue:
  4327.         [^(Form
  4328.             extent: 6@20
  4329.             fromArray: #(14336 31744 64512 63488 61440 34816 33792 33792 35840 38912 47104 62464 58368 52224 39936 47104 61440 57344 49152 32768)
  4330.             offset: -3@-2)].
  4331.     (type == 2) ifTrue:
  4332.         [^(Form
  4333.             extent: 7@20
  4334.             fromArray: #( 14336 31744 64512 63488 61440 33792 33280 33280 33280 33280 34304 34304 35840 39936 47104 61440 57344 49152 32768 32768)
  4335.             offset: -3@-2)].
  4336.     (type == 3) ifTrue:
  4337.         [^(Form
  4338.             extent: 6@20
  4339.             fromArray: #( 14336 31744 64512 63488 61440 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768)
  4340.             offset: -3@-2)].
  4341.     (type == 4) ifTrue:
  4342.         [^(Form
  4343.             extent: 6@20
  4344.             fromArray: #(14336 25600 52224 38912 61440 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768)
  4345.             offset: -3@-2)].
  4346.     (type == 5) ifTrue:
  4347.         [^(Form
  4348.             extent: 9@5
  4349.             fromArray: #(7936 26496 58240 62208 31744)
  4350.             offset: -4@-2)].
  4351.  
  4352.     "default: pretend I am a quarter note"
  4353.     ^(Form
  4354.             extent: 6@20
  4355.             fromArray: #( 14336 31744 64512 63488 61440 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768 32768)
  4356.             offset: -3@-2)!
  4357.  
  4358. form
  4359.  
  4360.     (stemDirection == #up)
  4361.         ifTrue: [^self upForm]
  4362.         ifFalse: [^self downForm]!
  4363.  
  4364. glyphDependsOn
  4365.  
  4366.     ^Array
  4367.         with: location
  4368.         with: self!
  4369.  
  4370. selectableGlyphsInto: aSet
  4371.  
  4372.     aSet add: self.!
  4373.  
  4374. upForm
  4375.  
  4376.     (type == 1) ifTrue:
  4377.         [^(Form
  4378.             extent: 11@21
  4379.             fromArray: #(1024 1024 1536 1792 1792 1408 1216 1088 1632 1824 1952 1248 1088 1056 1056 1056 15392 31808 64512 63488 28672)
  4380.             offset: -3@-18)].
  4381.     (type == 2) ifTrue:
  4382.         [^(Form
  4383.             extent: 11@21
  4384.             fromArray: #(1024 1024 1536 1792 1920 1472 1216 1120 1120 1056 1056 1056 1056 1056 1088 1152 15360 31744 64512 63488 28672)
  4385.             offset: -3@-18)].
  4386.     (type == 3) ifTrue:
  4387.         [^(Form
  4388.             extent: 6@20
  4389.             fromArray: #(1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 15360 31744 64512 63488 28672)
  4390.             offset: -3@-17)].
  4391.     (type == 4) ifTrue:
  4392.         [^(Form
  4393.             extent: 6@20
  4394.             fromArray: #(1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 15360 25600 52224 38912 28672)
  4395.             offset: -3@-17)].
  4396.     (type == 5) ifTrue:
  4397.         [^(Form
  4398.             extent: 9@5
  4399.             fromArray: #(7936 26496 58240 62208 31744)
  4400.             offset: -4@-2)].
  4401.  
  4402.     "default: pretend I am a quarter note"
  4403.     ^(Form
  4404.         extent: 6@20
  4405.         fromArray: #(1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 1024 15360 31744 64512 63488 28672)
  4406.         offset: -3@-17)!
  4407.  
  4408. visibleGlyphsInto: aSet
  4409.  
  4410.     aSet add: self.! !
  4411. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4412.  
  4413. NoteThing class
  4414.     instanceVariableNames: ''!
  4415.  
  4416.  
  4417. !NoteThing class methodsFor: 'class initialization'!
  4418.  
  4419. initialize
  4420.     "NoteThing initialize"
  4421.  
  4422.     self initializePrimitive.
  4423.     partIcon _ (Form
  4424.         extent: 16@16
  4425.         fromArray: #(128 192 224 240 184 152 140 140 140 140 136 1936 3968 8064 7936 3584)
  4426.         offset: 0@0).
  4427.     explainText _ 'A NoteThing represents a displayable note. It has a pitch, a duration type, a starting time, a stem direction, and a location.'.! !
  4428.  
  4429. NoteThing initialize!
  4430.  
  4431.  
  4432.